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SESTRACT 


The design and imelementation of the ALGOL*S” programming 


language for use cn a microprocessor=based system 15 
aescrived. The implementation nS comorisea o f two 
suOSYyStems, a compiler which generates code for 2 


hypothetical zerosradaress machine and a -frunstime monitor 
maanch executes this code. The system was implemented in 
PL/M to run on an 5980 microcomputer in a diskettershased 


environment with at least ecNK ovtes of user Storaae. 
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i ROUT TION 


Pomel ofORY OF ALGOL 


The definition of the alaorithmic lanauage (ALGOL~-50) 
was the result of the work of a committee of distinauished 
comeuter scientists ard was originally oublished in 1960 
il). The ourpose of the developers of ALGNL+-60 was the 
estaodlishment of a universal comouter lanauage soecifically 
gesigned to allow for the lonical and efficient orogram 
representation of algorithms. Additional] versions and 
extensions of ALGNL*09 such as 4LEQL-68 Lidl and ALGOL-w 
[160] have pbeen develooved and have found acceptance orimarily 
meee the academic communities and in Europe. The lanauage 
ALGOL=e& (10) is also Fased on ALGOL=00 and was develoned = as 
part of a complete system desianed for teachina orogramrmina 


lanaquage concepts. 


eee MICROCOMPUTER SOFTAARE 


The rapid develaprent of microcomputer hardware since 
1975 has aenerally resulted in a considerable tag in the 
meorresoonding agevelopment eli compatible software, 
particularly that of hiah level lannuages. The Intel 8000 
microorocessor 16 one of the few microorocessors whicn has 
endured tong enouch to oermit software develooment to 


advance pveyond tne assembiv lanauage level. in) one leve] 





lanauages which have teen develooes for 8080 pased systems 
by students at the Naval Postqraduate Scnool include a macro 
assembler (ML=-#0) (ke te, a BASTC comoiler/interpreter 
(BASIC-E) (ol, and a COROL comoiler/interpreter (CIMICRO- 
COBOL) {2}. The majority of hich level lanauages currently 
available for microcemputer based systems are extensions of 
the original Dartmouth RASIC and, although tney allow for a 
reasonable level of orogrammina sophistication, they are 
encumbered hy the inherent imitations of the BASIC 


lanaquage constructs. 


meee OO IJIECTIVES OF ALGOL=™ 


The major ohjective of this project was to develop a 
dynamic, Block =Structurec, recursive righ level lanquage 
whicn would provide adeauate orogrammina power and 
meexybility for aoplications orogrammino usina microcomouter 
based svstems. ALGOL constructs were chosen hecause of 
emer Ssimoticity amc power and because it was oossible to 
write the grammar in LALR(1) form for use with available 
comoilerscompiler aererated carse tables (14). ALGOL-” was 
developed to run on 8080 hased microcomouter systems hecause 
of the availability of a high level svstem develooment 
lanaquage (PIL/M) (Af) whicn ornoduces BUFO objsect code and 
maea coulda be rum om the “aval Postaradguate Schnol's I6&M 
360. The availability of an 8080 basea disk operatina 
System (CP/M) by) simulator an the IRM $60 was also 3 


fmerona tactOr 315 the choice of 8080 microorocessor and CP/M 





a | 
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epee cdil=t NSAnNGUAGE DESERIP TION 


eer ee URES OF {HE ALGCOL=M LANGUAGE 


Although ALGOL@“ was modeled after ALGUL=-60, no attenpt 
was made to make it a formal subset of ALGOL=-60. This was 
done intentionally tn order to orovide a language which 
would oe hest Suited to the needs of anplications 
proarammers using microcomputer svstems. However, the hasic 


structure of ALGOL=M js similar enouah to ALGUL "60 to allow 


simole conversion of proarams from one tlanguace to the 
Sener. Pits woeseGorsiGered Carticuiarliy imoortant in view 
of tne fact that themes CoOniGeare  “Oub lication language 1s 
ALGOL-60. Therefore, Cileiieme 6x)SstSecdaclarges) source of 


aoplications orograms and Iltbrary Procedures whieh obra \(a be 


simply converted to execute under ALGOL=<M, 


Ieee vee Declarations 

ALGOL|eEM supoorts tnree tyoes of variables: inteaers, 
fecimals, ance Sturn iaGs’. Tnteaers may be anv value hetween 
“16,384 and +16,584. Decimals mav he declared with uo to 1A 
Gicits of orecision and strinas may ve deciared as long as 
E55) mee ns The default ecrecision for decimals is ten 
Seeg1ts and the default length for strinas 1s ten characters. 
Decimal and strine variable lenaths may oe tnteaer variables 
which can be assianed actual values at run=time. 


Another form cf declaration in ALGUL@=™” is the array 


Ws 





declaration. Arrays may have up to 255 dimensions” witna 
each dimension rangine from -160,3584 to +16,3848. The maximum 
8080 microprocesor address soace of 64k oytes limits 
practical array sizes to somethinq smaller than the 
maximum. Dimension bounds may be integer variables with the 
actual values assigned at run-time. Arravs may be of type 


integer, decimal or strina. 


Ee AGI tHmetic Processing 

Integer and tinary coded aecimal af tb mee Gummo eC 
Supporteaq under ALGOL=M, Inteaers may be used in decimal 
expressions and will te converted to decimals at run-time. 
The itinteqer and decimal comoarisons of tlessethan (<), 
gQreaterethan (>), eaqualeto (=), noteenualeto (<>), lessee 
than=orsequaleto (<=), and areater=tnan-or-equale=to (>=) are 
providec. Additionally, the loaical aperators AND, OR and 


Mie are available. 


beer Gomt rol stfuctures 

Dec MmcaCmurciestCUetUures ComsSist of BEGIN, END, 
mite tG 1HEN, IF THEN ELSE, WHILE, CASE and GOTO constructs. 
Function and procedure calls are alsSo used aS contro! 
eeructures. ALGOL=M 3s a block stuctured language with a 
block normally bracketed hy a SEGIN ana an FND. Blocks = trav 
be nested within otner hlocks to nine jJevels. Variables 
which are aeclared within a olock can only ne referenced 
Mme ym that Block of a bleck nested within that block. unce 
BOroagram contro] proceeds outside of a etlock tn which 42 


variable has been declared, tne variable may hot De 


ie 





referenced and, 1n fact, runstime storage snace Lor that 
variable no lonaer exists. 

Functions, when called, return an iaintecer, decimal 
Sieest ring value Gecendina on the tyre of the function. 
Procedures do not return a value when callea. Both 
functions and procedures may have zero or more parameters 
which are call by value and both may be called recursively. 
Additionally, functicns ard orocedures may be referenced 


before they are declared. 


Teo i neuts, UUtpuUT 

The ALGOL=-M WFITE statement causes output to the 
console on a new tine. The desired outout 18 specified in a 
weaite tist whitch 16 enclosed 17 parentheses. Seale Winve 
constants may he usec 1N a write Jist and are characterized 
By beInGa enclosed im cuotation marks. my | Comeumat 1om. ot 
integer, decimal Aneceeestenma VaorilabveG or exeressions may 
also be used in awrite list. A "RITEON statement 1S also 
available which 16 essentially the same as the WRITE 
Statement except tnat outout continues on the same |line as 
the outout from a orevious YRITE or ARITEON Statement. xrnwhen 
a total of 80 characters have ceenr written to the console, a 
new line 1s started automatically. A TAB oetion may also be 
used in the write |ist which causes the following item in 
the write Jist EQUOrEESOaced to the riant by a soecifed 
amount . 

Console input is accomplished by the READ statement 


followed by a read rpst oO f any comoination of integer, 





decimal and strina variaodles enclosed in parentheses. Lae 
embedded blanks are desired iin the ineout for a strina 
variable, the console input must he enclosed in auotation 
marks. A READ statement will result im a halt im orogram 
execution at runtime until the inout values are tyoed at 
Bre console and a carriaqe return is sent. I[f the values 
typed at the console match the read ist in number and tyne, 
Srogram execution ccntinues. Diwan error sasuto NUMOehr OF 
type of variables from the console occurs, orogram execution 


1s again haltedqg until values are resentered on the console. 


S. Disk Access 

ALGONL-M proarams may read data from, or write dat3 
EO» one or more disk files which may be located on one or 
more disk Orives. tiem) fe wpuUt. | OF » cutout 1S Qesired, 
the apreropriate READ or wPITE statement is modified ov 
Olacing a filename icentifier immediately after RFAM or 
ARITE. The actual name of the file may be assianed to the 
file name identifier when the proaram 18 written or it may 
be assigned at runwtime. Various disk drives are referenced 
by the letters A ieirieelUre na Lie A soecific oarive may oe 
soecified ov orefixina the actual f11% name with the desired 
Omrive letter followed by 4 colom. Additionally, if random 
file access iS desired, tke file name identifier may be 
followed by an integer constant, variable or expression 
enclosed in parentneses. This integer value specifies the 
Secorad within the file wnich 15 to he used for jinout/output. 


Prinr to tne use of a file name identifier in a READ 


14 





or WRITE statement, the file name identifier must anpear in 
a file declaration staterent. The file name identifier can 
only be referenced within the same block for a lower block) 
as the file declaration. Files are normally treated as 
unolocked sequential files. However, if blocked files are 
agesired, the record length may ootionally be snecified in 
parentheses after the file name identifier in the file 


Geclaration statement. 





Piet Pe bEMENTATITON 


PCO MritLeR [MPLEMENTATION 


I. €Comorler Oraanization 

The compiler was desianed to read source lanquage 
Statements from a ciskette ang to proauce an intermediate 
lanauage file with aptional Source listina at the console. 
a two pass apo Ccach was used to facilitate the 
implementation of GOTC statements, forward subroutines, and 
eonmt rol Statements. Pass one ruilds the symbol table and 
saves all branch locations for resolution curtna pass’ two. 
Pass one also computes the size of the program reference 
maole (PFI) and writes this information out fc the 
intermediate file. Pass two resolves all forward references 


ema@eemits code to the interrediate file on disk. 


eee ee amet 

The scanner aralyses the source proaram ang sends a 
sequence of tokens to the parser. In adoaition, fhe scanner 
provides a listing cf the source file (ait requested), 
1an0res remarks, and sets the comoiler toqgles. Analysis of 
the first non-olankx character in the inout file determines 
the aqeneral class of the next token. The rest of the token 
is then scanned as it is placed into the accumulator 
f/m.CCUM). Tae first byte of ACCIIM contains tne length of tne 


token. Uremenemease =O Comstants that exceed the Size oO f 


lo 





ACCUM (32 bytes) a continuation flaq is set. This permits 
the Scanner and oarser to continue as necessary to accept 
the entire constant. 

When the scanner recognizes. an waent)17er ae 
searches the vocabulary table (VOCAB) to determine if the 
identifier is a reserved word. If found, the token number 
associated with the reserved word's nosition in the VOCAB 
table is returned. The reserved word COMMENT 15s a special 
case since it VG MOtNoaort lof the Grarmar and +s. handled 
Setyrely by the scanner. The VOCAG table 18 one of the 
taoles provided ov the LALR(1) carse table gqeneratoril4d). 

Constants are passed unconverted from the scanner 
through the oarser to the intermediate file. Althouch this 
procedure does not allow constant enecking during Compire 
time, 1t does Save soace 1M the compiler. The conversion 
aoueines Must be In the run-time system for console iinout 
and their auplicaticn in the corpiler was not considered 


mecessary e 


Bat oymmol Table 

The symbol table stores attributes of proaram and 
compiler aqenerated entities such as identifiers, procedures, 
and labels. The symbol tahle is constructed durina pass one 
and fhe stored information is used by the compiler durina 
pass two to verifv tnat the proaram is semantically correct 
and to assist in code oaeneration. Access to the symbol 
table 1s accomelishec throuch various subroutines which 


operate oan the symbol! taklie tnrough the use of based global 





variables. 

The symbol table is modeled after the BASIC=E svmbol 
table [fo]. It 1s an unordered linear list of entries which 
grows toward the too of memory. imairy) dud entries are 
accessed via a chained hash addressing techniaue 9 as 


illustrated in Fiaqure 1. PaAcheulocat1on. 1m the hash tab } 


‘D 


heads 3 linked ies t whose printnames all evaluate to th 


D 


same hash adogress. If there is a zero in the hash table 
then there are no entries for that particular hash value. 
During references to tne symoo)] tabnte, the global variable 
PRPINTNAME contains the address of a variable whicn contains 
the jlenath of the variable name followed by the name itself. 
The Variable Sethe Sn comtains the sum of the ASELT 
characters tnat mak® uo the variable name, POWUTO sod. 
Entries which hash to the same value are chained so that the 
latest entry is the first one on the chain.w Trev are, 
however, Scereomw an the symbol table in tre order in which 
they aooear in the orogram,. 

Each entry 1m the svymhol table contains tne 


folowing informations: 


beneath of “oOrintmare 1 byte 

Gor VSton.t1e)d 2 hytes 
printname variable lenath 
type 1 byte 

address P bytes 

plocKx level] tl byte 

subdtyre 1 byte 





SIoioOnhm cabins STRUGLURE 


SYMBOL 
TABLE 
HASH ARRAY 
28 
ECLELe TON 
c ° FIELD 
18 
. COMRUIS ION 
2 Saye 
aa PO Niees 
HASH VALUES 
| ae 0 


Ee 
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The address’ field indicates the reentthier Ss 
position in the PPf unless the tdentifier is a label. For 
labels, it indicates the lanel'S position in the code area. 
For subroutines, there are two extra symool table entries: 
a parameter field which indicates the number of parameters 
associated with the subroutine fl bvte)s, and another aadress 
field which ingicates the position of the subroutine in the 
code area. 

Since eoue-“=s Come etely Olock structured, there 
is a block number associated with each identifier in tne 
symbol table. A "previous block level stack" was designed 
ie order to retain the symbol table for deouacing purnoses 
mrermag rFunmetime. Each sctive block is used as an inaex into 
Mas stack which centatins a!!1 blocks to which the active 
Berock 1S SUhOrdinate. When a olock 1S deactivated (1.e., 
the corresoondina block end is encountered), Chemm lack 
number 1S removed from tne previous blocK stack and 
therefore any identifiers associated with that olock oecome 
inaccessible. 

rTwo different lookup routines were designed to 
maerlitate symbol table lookup. fhe first 18 FULLSLOUOKLP 
mean searches the current biock and all outer blecks for an 
identifier. The secona 1s NORFMALFSFLOOKUP which simply checks 
the current block level. In most cases, PUL tlh OUthre = 15 
used to determine if an identifier heina used has been 
declared and NORMAL SLOQKUP 71S usead to determine 1f oan 
identifier being declared kas heen previously deciared in 


the same block level. 





4. Parser 

Phew eOmemmarser ss modeled after that of the BASICH=F 
parser fo), which 18 a tahblewdriven pushdown automaton. ee 
receives tokens from the scanner and analyzes them to 
determine if they are part of the ALGOL*=M grammar. When the 
parser acceots a token, one of the following actions wil! 
be taken. It mav save the token and continue to accept 
tokens in tke lookahead state, or it mav recoanize the riaht 
part of one of the valid productions and esoply the 
production state (cause a reduction to take place). ie tek te YZ 
the parser mav determine that the tokens received do not 
Neem a Valid fiemt Oart for a production in the grammar and 
M@ause a syntax error to be orinted. 

When an error is detected RECOVER is called ana tne 
parser backs up a state with an attempt to continue parsina 
from that state. teens etan bS¢ iearcOneimMgdes to oack Sup 
meri the end of the currently oending reductior is reacned. 
At that point the bad token 1s byoasseq ana an attempt to 
parse the followina toker jis made until) an acceptable token 
io) found. 

The major data structures in the parser are the 
LALR(1) parse tables and the oarse stacks. The parse stacks 
Mmemsist of a state stack and six auxiliary stacks. Tnese 
auxiliary sac. are carallel to the oarse stack and are 
moeo to store information needed during code caeneration. 
The information stored in these stacks itincluces variable 


types, subtypes, and variahle addresses. 
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S. Code Generation 

The parser not only verifies the syntax of source 
statements, but also controls code aeneration by associatina 
semantic actions with reductions. then a reduction takes 
polace, the Ceeececure “SsY‘NTHESIZE is called with the 
production number aS a parameter. OV NMRES TZ “comes the 
needed semantic infarmatian from the parse stacks into 
simole variables (te avoid extensive subdserintino) = and 
performs tne aporcpriate semantic Jet yom. This 1S 
accomplished by the use of a large case Statement with the 
production number as a key. The syntax of the languaae, 
along with the semantic actions taken, 185 listed in Anpendi.x 


Eve 


eeeeel TERPRETER IMPLEMENTATION 


Joe Buildina the ALGOL=M Pseudo Machine 


The ALGOL=*M pseudo rachiner as Shown in Fiaure Cr 
1s a software emulation of a stackzoriented CPI) with an 
mmotruction set which 1S oarticularly well SuUlteade eter 
execution Of eT eoUaMmoroaramnms « The ALGOL]=M Interpreter 


1$ loaged at address 100 hex (as are all executadle proarams 
under the CP/M onerating system) and proceeds to read the 
meouL=M intermediate code from disk, constructing the pseudo 
meenhine hearning at the first free memory locatton. The 
ALGOL=M intermediate code is read into a buffer in 1c ovte 
segments. The fle St two bytes of the intermediate code 


reoresent an inteqer value equal to the number of hytes 


Ze 





to be used for the program reference table (PRT). Each PRT 
location 1s two bytes in length and 1s used to contain 
information relative to ALGOL=M proaoram identifiers, arrays, 
and subroutines. 

The remainine intermediate code is manipulated 
im accordance with the alaorithm shown tn Figure 5 in 


oraer to construct the pseudo machine code area. 


2. Overview of the Interpreter 
The ALGOL|=M interpreter uses the nmseudo machine code 
area as 1nout data. Each pseudo machine operator 1S 
equated to an integer value which is evaluated in order to 


provide tre correct entry nmoint into a large case statement 


fim the interoreter. Fach entry in the case statement 
contains the necessary code to cause oroper run-time 
Beecution of the scecific ALGOL=M SPseude  iastruct von. 
The case statement 1S executed continually until the 


ALGOL=M program has heen camoleted, at which time contro! 


1$ oassed back to the operating svstem. A runetime stack 15S 


used to facthitate the execution ot ALGOL=M pseuan 
mast ructions. The stack can be viewed as Feina two bytes 
wide and expandine GEeeGont Gact ine above the ALGOL=<M 


machine code area as necessary. The too item on the stack 
1s addressed Fy the variable PA, while the next=tortoc iiten 
1S addressed hy RB. Tne contents of the two Fytes on ton 
of the stack are referenced by the variavle AKA while 
Mme two byte contents of the nextrto=top stack position are 


referenced by the variable APB, The low order bvte 


0) 





STACK 
' RB 

CODE AREA 

RC ~> 

0004 

ER REFERENCE 
0002 TABLE (path 
0000 

za 

ROPER 
1O0H 


ALGOL~-M MACHINE 
MEMORY ORGANIZATION 


PeGWini =2 
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GET NEXT 
Bete FROM 
INT FILE 


or) 


+9 STR" 


STORE: IN 


CODE AREA 


ine, 





oO 


PIGURE 3 


SLORD Bye “PLUS NEAL BYTE 
IN ALGOL-M PSEUDO MACHINE 





CODE AREA 


STORE BYTE IN CODE AREA, 
READ IN ASCII NUMBERS UNTIL 

BINARY ZERO, CONVERT TO TWO 
Byles INSERNAL FORM, STORES iN 
ODE AREA 






SLORE BYTE IN CODE AREA, READ 
IN ASCII CHARACTERS UNTIL BINAR 
ZERO, CONVERT TO INTERNAL FORM, 
STORE IN CODE AREA 






STORE BYTE IN CODE AREA, READ 
IN ASCII DIGITS AND DECIMAL 

POINT UNTIL BINARY ZERO, CONVER 
TO INTERNAL FORM, STORE IN CODE 
AREA 












READ IN NEAT TWO BYTES, ADD 

VALUE OF THESE TO CODE BASE, 

STORE IN CODE AREA 
i 













READ i NEAT BYTE, STORE IN 
CODE AREA 


READ IN NEXT TWO BYTES, 
STORE IN CODE AREA 


Pie) 





contents of the tHoommanaG mext=to-tfoo stack loGgcat1ons 


are referenced by the variables RRA ainic RRR 
resoectively. The various stack variables are depicted in 
Figure 4. 


See Allocation of Storaae Soace 

Run=time storaqe space 1S reauirea for the 
values associated with ALtGOL-M orogram identifiers which 
have been declared as integer, decimal, or string values, 
and Lor informaticn needed to process arravs) and 
subroutines. A sequential number 18 assianed to each new 
Haemcitier aS 1t +S Fecognized by the comojlier. This number 
meusea to reference the PRI at run-time in order to store 


or retrieve the value associated with each identifier. 


ae Integers 

Integer values range from 216,584 to +16,384 and 
Sime stored directly in the two bytes allocated in the PRT 
Hom integer identifiers. A maximum lenath of two ovtes’ for 
integer values was chosen because the resulting range of 
possible inteaer values was considered adeauate for the 
primary use of integers aS oOrogram contro! counters, such as 
array suodscrints and loon boundaries. Aaditionally, two- 
byte values were the most convenient size to work with in 
the implementation language PL/M (81. The hian orager pit of 
the integer representation ic the Sonnets). pwilt 
zero indicating a opcsitive value and one indicating a 
negative value. The second Bet o f the inteaer 


reoresentationr 1S alwavs zero mn order to permit 
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ARA 


BRA 


ALGOL~M STACK 
VARIABLES 


FIGURE 4 
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differentation retween integers and other types on the 
Stack « The ALGOL-*s internal form for addresses is also 3a 


two byte value. 


be. Decimals 

Becimal=vaides up to [8 diaits in lenatn are 
permitted in the ALGUL=#M langquaae. Fach aecimal 
identifier is associated with a unique PRT entry. The value 
stored Pare che twoemoyte fe Peent Fy reoresents the rune 
time address of the location on the ALGOQOL@M stack where 
the actual aecimal value 1s stored. The format for 
decimal storage is shown in Figure 6. 

The nextetorlast hyre of the allocated Space 
for decimal 1aentifiers contains the number of voytes used 
for storaaqe of that value. This value is a function of the 
ace declarea for the decimal bv tne orogrammer and may be 
gelayed until run\etime. A maximum ole | be diay ts ahee 
precision may be declared wht tne) default oreCcTs 109 
oeing ten aigits. The firpst Syte of the oaecimal storage 
area contains a value representina the number of bytes 
meee to hold tne actual packed diaits. This value may be 
less than the number of pvytes whicn could ove stored in the 
allocated area. In order to save storaae soace, the decimal 
Values are oacked two aigits cer byte of storage space. 

ALGOL-M is a block structured langquaace based 
uOON a Stack model for execution. Thus, it allows efficient 
allocation of Stcrageé eve decimal PWeaeqtifvers . A 


foc k 1s normally bDracKxeted by tne ALGCL=@-M keywords 





BEGIN 
INTEGER A,B; 


A := 3; 
B := =2; 
END 


SLCN Bit 
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LOW ORDER HEGH ORDER 
BYTE Brls 
SLGN: BIT 
ae 


0705080 0. O71 0 HO OO 0°00 70 sae 





INTEGER STORAGE 


PiGURE > 
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BEGIN 
DECIMAL(12) xX; 
X := 123456.78; 
END 


OPE Stil »i@ 
BOTTOM OF 
DECIMAL 
STORAGE 


SIGN (+) 


78 


56 


ihZ 34 


ACTUAL NO. 
OE sr TES 
USED FOR 
DECIMAL 
VALUE 


DECIMAL POINT 
OBESE! 


o TACK 


DECIMAL STORAGE 
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BEGIN and END. Blocks may be emhedged within ai higher 
level block as shown in Figure 7. Identifiers which are 
declared in a given block are considereag local to that 
block ana global to ary lower lever olock and therefore may 
be referenced from those DiloG ksi. However, once 
execution of an ALGOL=” program oroceeds beyond a given 
blocKk, the iagentifiers declared within tnat block may no 
longer he referenced and, in fact, tne storage allocated for 
those identifiers 1S removed from the ALGOL=M machine 


Stack. 


Ge wotee i mas 

SenimesmortaeoCl! eharcacters wo to ¢55 bytes in 
lenath are permited in ALGOLeM, In tne same manner as used 
for decimal storaaer the strina identifier 1S associated 
with a unique PRT entrv. The corresoondina PRT entry 
contains tne aadress cf the actual string storace space on 
the ALGOL=-4 stack. The format for string storage 1S 
Shown in Fiaure 8. The next-toelast byte of the allocated 
Storace space for a strina identifier contains the value of 
the numher of bytes actually allocated hy the Droarammer un 
moma maximum of 255 hytes. The first hyte of the 
allocated string storage Aer contains fhe value of tne 
actual number of ASCII characters stored in the allocated 
area. Tne concept of storane allocation as related to Flock 


levels 15 the same as gescribed for cecimal identifiers. 
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BLOCK LEVEL 0 —=———?>BEGIN 
. ry DECIMAL A,B,C; 


BLOCK LEVEL 1 ——-~——-~-» BEGIN 
STRING X,Y,2Z; 
BLOCK LEVEL 2 ——————————""> BEGIN 
DECIMAL €7,D,E; 
END BLOCK LEVEL 2 ————» END; 
END BLOCK LEVEL 1 ——>} END; 
D BLOCK LEVEL O -» END; 


LEVEL ADDRESS 
STACK 


STORAGE FOR 
BLOCK LEVEL 2 


STORAGE FOR 
BLOCK LEVEL 1 


STORAGE FOR 
BLOCK LEVEL 0 





BLOCK LEVELS AND STACK STORAGE 


PGR E 7 
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BEGIN 

STRING(9) TESTWORD; 
TESTWORD := "HELLO"; 
END 


OLD Sy dthe 2he, 
BOTTOM OF 
STRING 
STORAGE 


ACTUAL 
NUMBER OF 
CHARACTERS 
STORED 





STACK 


STRING STORAGE 


FIGURE 8 
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d. Arrays 
ALGOL=-M arrays may be Ot type integer, 
decimal, Or) StPI2AG. aopaySmemayie COnsist of uD to 255 


dimensions with eacn dimension containina uo to 16,584 


elements. The uoper and lower bounds of each dimension 
may consist of any mnositive inteqers, variables, or 
aritnmetic ePxoressions.e Eacn array name 1s associated 


with a unique PPT entry. The PRT entry contains tne address 
pointer to the actual array storage area on the ALGOL=-™ 
machine stack. fhe first part of the array storage area on 
the stack consists of the displacement vector and otter 
information which is necessary to calculate the address 
of any specific array elemert at run-time. Fhe format for 
pray storaqe iS shown in Fiaure 9, The allocated storage 
area for each array element 15 exactly like that used for 
integers, decimals, or strinas which are declered as 
single identifiers. The algorithm used for calculatina tne 


disolacement vector 18 exoressed as? 
\F I=N THEN 1, OTHERWISE 


D, zi (Wen ~Lrer tL) + Drs 


where N 1S the number af dimensions, fi 1s the 
resocective dimension, and I! igs the unmper bdound ang L 18 the 
lower bound of a dimension. 
The offset vector, Vr 18s calculated bv: 
N 
Vi ara ; be (De 

t=) 
The offset vector represents the correction necessary for 
mem=zero-origin Suipses tots. This anmproach te locating 
elements tn dynamically ogeclared arrays 18 essentially tne 


same as that used 1n ALGEOLNF F190). 
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ACTUAL STORAGE 
AREA FOR ARRAY 
ELEMENTS 


TOP ADDRESS 
FOR ARRAY STORAGE 





ERE ENTRY 
FOR 
ARRAY NAME 


ARRAY STORAGE ON THE STACK 


FIGURE 9 
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4. Storaae and Retrieval of Variables 

WimeewnalleGation “of storage for Vania es has 
oeen completed at run=time, storage and retrieval of actual 
values is relatively simple. A check is first made to 
insure that the number of bytes to ve stored is less than 
or equal to the storaae space allocated for a aiven 
variable. lime the = Gase of Strings, if the destination 
storaqe space 1s not larae enouaqn to hold the entire 
string, aS many characters as oossidle are stored and 4a 
run=time warning messaace 1s VSESUeEQ env isima thst Stir) mo 
overflow has occurred. For decimal storage, if the total 
mumoer Of packed diqits to be stored is larger tran tne 
available storage space, nonesignificant aigits are deleted 
until the cecimal value can be stored. I IE US emi i Cami 
digit must be deletec in order to store a decimal values, an 
error messaqe 18S aenerated and the stored decimal value 
memmparoitrarcily set to 1.0 tn allow continuation of orogram 


eryrecution. 


Array elements) are stored exec ty as rhe 
corresponding single element variables. Fowever, rhe 
gata located at the heainnina of each array storage area 
(refer to Figure 9Q) HS  'Use@utoq —caleulete the actual 


location of a seecific arrav element. This 18 accomolished 
Myers imitializina the offset variable to the value of the 
rightmost suoscrioted value. This value 1s then acded to 
the product of the next rightmost sudscriontedad value and the 
gem disolacement vector value. This procedure is continued 


until the leftemost Suisse riotred value has been used mn 
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the calculation. Next the offset vector, v » plus one, is 
suotracted from the offset variable and the result is 
multiplied by the size of the area allocated to each array 
element. ipemeresuilt "OF this calculation 1s the total 
offset, in bytes, from the beginning of the storage area 
for the array to the specific array element in question. A 
check 1S made to insure the calculated total offset 1s 
not areater than the offset which would result in access to 
the last arrav element. An error message 1S aqenerated by 
the interoreter if a subscripted variadle is referenced with 
Ssuoscriopts that are not within the declared array 


Gimensions. 


pa Arythmetic Operations 
Arithmetic onrerations for intener variables are 
Straightforward because tke imolementation lanauage, FL/M 
[8}, orovides all of the necessary two hyte ariftnmetic 
operations. Therefore, the two inteaqer values which are 
to be adaeg, subtracted, mnultiplieda, or divideg are placed 


one 3z00ve the other On the stack and the aporopriate 


routine performs the necessary arithmetic oDeration, 
replacing the oricinal two inteqer values with the 
eesuit of that operation. The resulting value 1s 6then 


meeulable to store irto the space allocated for an inteaer 
variable or to ode used as one of the integer values’ for 
Bomeinued arithmetic cnerations. 

Decimal arithmetic is accomolished ov manipulatina 


oacked oecimal strinas, escheat wntcn 1S loaqgeqg If a ten 


of 





eyte reaister (two dicits per byte). Pie eres ten sot “the 
decimal] arithmetic ooeration 1s stored in By isin: 
register. Decimal values are also stored in the packed 


decimal form, Shown in Fiaure 6. Decimal strinas are only 


unpacked when and if tney are written to aisk or console 
at EuA—C1ne . Decimal addition is accomp)ishea Dy 
addina the two reaisters, subtraction is done usina 
nines complement arithmetic, multiolication 1S gone 


Benpouach a shift By) ee Vidor i thm, mG division Oy a shift 
and suotract metnod. After the decimal arithmetic 
operation is comoleted, the result is olaced on the too of 
mee stack im oreparation for a decimal store operation or 


mse aS a new value in a continuina alaebhraic exoression. 


ee otring Ooerations 

The ALGOL=M comoiler is designed to hanale strings 
Memeeto clas characters in ltength. The concatenation operator 
allows two or more strings to be combined to oroauce 2 new 
menina consistina of a] ) the characters contained in 
mee original strings. The orecess of concatenation takes 
place on the stack with strinas oeing combined 
repeatedly as necessary Tor Mtr Ole —concatenati ons. 
mre resultina strine is then available o}lx SAR ee Tia 
the space allocated to a strina identifier. If tne result 
Pee concatenaticn orcduces 8 strina wnich 18 j|Jonaqer than 
the allocated storaane space, Gre sString 1s @trupceated as 


necessary and an error messaqe 1s issued by the interoreter. 
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i =e CUD rout nes 
There are two tvpes of subroutines in ALGOL=M: 
heme tions and procedures. The only difference hetween the 
two 1S that a function returns a value to the too of tne 
stack while a proceaqure does not. Subroutines are fully 


recursive anda can be called prior to their declaration. 


ae Invocation 


A subroutine can be invoked with zero or more 


ae tte | Oarameters. The actual Darameters consist ort 
integer, decimal, or string expressions which are 
evaluated and massed to the Subroutine v1a the 


execution stack. In addition to parameter values, the only 
other information needed to call a procedure 1s the 
procedure address in the code area. Tne actual format= Sort 
Omen stack at the poirt of a subroutine call 1s tndicateg in 


Figure 10. 


Daemotcorage Alliaocation 

Storaae fer variables and parameters declarec 
within a suoroutine is allocated on the stack at runstime. 
The actual oarameters ang the subroutine cali information 1s 
also stored on the execution stack. To allow subroutine 
call by value and to Save memcocrvy 1% was necessary to move 
the actual parameter values and subroutine call information 
eeereecme Stack prior tc allocating storage for the formal 
parameters and local variables. This was accomolished by 
mMOVINQ then to the ton of available memory. Storage can 


then pe allocated TORmtne  'Ornmal parameters on top of the 


Be 





SEACK CONFIGURATION FOR 
mano OFGBRATOR 


BEEPORE AFTER 


<TOP OF MEMORY <TOP OF MEMORY: 

<RETURN ADDR 
RA> ‘tN CODE AREA 

<lst PARM TYPE 

<PARAMETER 

<2nd PARM TYPE 

<PARAMETER 

RA> <lst PARM TYPE 

<PARAMETER 
<2nd PARM TYPE 
<PARAMETER 


FIGURE 10 
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stack In the normal manner. This move was accomplished 
througn the SAV onerator as illustrateaq in Figure I!1. The 
SAV operator also checxs to determine if the call is a 
recursive call and if sor saves the oroceaure control block 
Bebmgeom top of the stack. The PCS 1s similar in structure 
Momeptnat of ALGOL=-E[10). Although this procedure slows down 
the execution soeed of the interpreter, 1t was considered 
more imoortant to save memory soace. Storing suoroutine 
values on the stack as indicated above simolifies the de- 
mamecation of memory at the end of the subroutine. This 3s 
accomolished by simoly removing elements from the stack down 


to tne aporopriate level. 


ce. Parameter Mapoing 
poOroanmereremaocermG 1S done through the use of the 
o¥e operator as Memsceratea i'm F1Qqure id. The operator 
copies the actual] parameter information at tne too of memory 
meee the area allocated on too of the stack. The PCR 
which keeos track of subroutine variables 18 then set with 


oointers to the current oarameter values. 


ele Function Feturn Value 
Included with the allocatea area for parameters 
Salle: local variables, rhere 1S an additional allocated 


area for the return value of functions. The fumet VOR name 


1S treated as a Simole variaole within the fume tron 
and the return value 18 assianed to tr. This value 1s 
Gopied to the veo erie the stack when ther tunection 


me curns. 
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Ce. EMeerma ler unet 1ons 


The ALGOL=M grammar suoports external 
function declarations and, although they have not been 
implemented, their desian has been considered. External 


functions are conceived to be ALGOL*M intermediate files 
which could be deciared and called from otner ALGOL=M 
programs. The intermediate code COG tnese files would 
be read from disk by the compiler and itnteqrated into the 
proaram intermediate code as 1f the external subroutine 
had in fact been F normal Sroaram SunroutIne. The 
grammar would reauire modification in O@qder © to) a) low oa 


subroutine to oe compilea by itself. 


ft. Forward References 
Forwaraq suoroutine references are supported ov 
Simoly treating al] undeclared identifiers as forward 
subroutine references durina oass one of tne compiler. I f 
on oass two these references have not heen resolved, then 


an undeclared variable error is generated ov the compiler. 


eres Cm=tm FUMet ions 


There are currently no builtein functions in 


ALGOL]=M, However, their iImolementation has peen 
considerea. To imolement rFuilteirn functions, a simole 
modification oe) the symbo] table structure would pve 


needed, Siowigort oe soul )lt=I1m fuMmetion mames to be entered 
mn the symbol table when 1¢ 1s ime a) + 2ed « There 
mer be an onerator associated with each function name rn 


the symbol tattle wnich would indicate the run-time action toa 


a fil 





be taken. This onmerator would be emitted each time the 


built-in function was referenced. 


8. Inpoput-OQutout 

Two basic types of PipuUt=out out Gi7 3) are 
implemented im the ALGOL=M Janauage: console and disk. 
Monsole [1/0 refers to the device which is being used to 
provide commands to the system, tyoicallv a cathnde-ray 
tune terminal or a teletvoe. Impeut 1s accomp !ismed via 
ALGOL=M orogram READ statements and outout via WRITE or 
WRITEON statements. Inteaer ard decimal values, includina 
SIQNS and gecimal CO1NtS, are converted from their 
internal reoresentation into ASCII characters which are 
provided to an operating system orint routine for console 
eutout. String variables ‘ana constants are stored al 
the ALGOL=M oseudo=machine as ASCII strinas ana are sent 
mmaracter by cnaracter to the system orint routine. Console 
input 18 |accomolishec v13a an operating system routine which 
meacs one full console Tine into an ALGOQOL=<™ buffer. Tne 
interpreter examines the buffer and converts the ASCIT 
Smaracters wn the buffer into fhe arprooriate ALGUL=<M 
mternal decimal, WOLeGer wor) Ssfrima fornart. i eam nOut 
value 1S then storeaq in the space allocated for its 
variable name. 

Lice ieewenenOwor ih lte statement for disk I/0 
contains the name of the disk file to ke uSsea and, 
optionally, snecifies the disk drive containing that files 


The default arive is the currently toaged grive [4]. An 
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aaavevonal option is that any soecific recora on the _ file 
may also be specified in the ALGOL=-M PEAD or WRITE 
statement. A file declaration Statement is used to 
associate file igentifier names with a specific entry in the 
ALGOL=-M PRT. At run-time, space is allocated on the 
ALGOL-M stack ror finlewcomtro sb locKk (Ff eS)-1ntormatton 
necesSary to interface file ooerations with the 
operating system. [Gpmradeationneeto the FER, Se ocemn) > 
also allocated for a 1eR byte I/0 buffer for each declared 
frie. The routines to convert packed decimal and inteaer 
numbers from internal form to ASCII form, andag vice-versa, 
which are used for writing te and readina from disk files 
are the same as those used for console [/0. Anv number of 
files may he open simultaneouslv and, as with all rune 
time storage, the soace allocated on the stack for file 


operations is recovered when the block is exited. 


9. ALGOL=-M Pseude Operators 


ae Descripticn of Interpreter Variavdles 

The top item on the ALGOL=M stack is addressed 
by the variadle RA while tne next=to too item on the stack 
1s addressed hy the variable FB. The value contained ir the 
first two bvtes addressed bv RA and RB are referenced cy tne 
variables APA and ARB resnrectivelyv. Prewmeecomtents “of “the 
lowmorder byte of AKA and ARB is referenced by the variakie 
BRA or BRR respectively. The structure of the stack is 
shown a1n Fiaqure 4, Decimal] and string values may oe 


represented on the stack by an address which yields the 
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actual storage area fer the value, or by the actual value 
meself stored as one of the items on the stack. when a 
gecimal or string value 1s stored on the stack, it is 
referred to aS a temporary value. Temoorary values are 
stored on the stack in oreparation for storage into the area 
allocated to a specific identifier, or for use as a value in 
the evaluation of an exoression. 

The ALGOL|=M comoiler generates various pseudo 
operators which were chosen to allow effective run-time 
execution of the ALGOL=“ oseudo machine. Ou FOw Tad 1s 3 
mem Of the psetido onerators ana a brief description of the 
action taken at run-time when each operator is encountered 


im the ALGOL®=™” code area. 


be. Literal Data References 

An initial check is made of each one pyte 
ooerator in the code area in order to determine if the high 
meager bit of that byte 1s set to one. [If the high order bit 
is set then the least significant 14 bits of that bdvte and 
the following oyte are automatically added to the adaoress of 
the beainnina of tne program reference table and placed on 
top of the stack. ‘4 cneck is then made of the second bit of 
mime original hyte and if it also is set to ane the PRT 
address now on too of the stack 18 renlacecd by tne contents 
of the two pvtes cointed to hy that address. These are 
peferred to as LIT ane LITLOO onwerators. 

INT: €integer). Tne followina two byte inteaer 


wearue 1S olaced on the stack. 
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SeRe (str ine). The proqram counter 1S 
incremented oast the following string constant and the 
adaress of the nextr-torlast ovte of the strinaq constant 1s 
placed on the stack. 

DEELs  Caecimal). The proaram counter is 
incremented past the followina ‘decimal constant and the 
address of the nextetorlast byte of the agecimal is olacea on 
the stack. The nextetorlast byte of the decimal constant 
Semtains the offset te the first byte of the canstant which 
Moe curm contains the value of the number of bvtes ir which 
actual decimal diqits are stored. 

DieriGehoad aome myre iamntecer). The value of 
the followina byte 18 converted to a two oyte value and 
placed on the stack. 

IMe: fload a two byte integer). The followina 


two byte value is placed on the stack in reverse order. 


CuI OGcatuton operators 

ALD: (allocate decimal). Storaae for a decimal 
variable 1s allocated on the stack and the adcress of the 
allocated area ts placed in the PPT entry for the snecific 
decimal] variable. 

Mot totGcateusStriggis. i ctorage for a strina 
variable is allocateq on the stack and the address of the 
umeoecateG area 1S placed 1m the PPT entry for tne smecific 
Strina variapole. 

ATD: Callocate intermediate gecimal). The same 


action 1s taken as in ALD except the declared aecimal lenath 
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iseelert om too of the stack in preparation for the next 
allocation which 15 exvected to immediately follow in the 
code area. fhis ooerator 1s used wren several decimal 
identifiers are declared ina single declaration Statement. 
ATS: (allocate intermediate strina). The same 
action 318 taken as in the AID operator with the exception 


that string allocation is used. 


Gd. Arithmetic Operators 

ADI: Cadd integer). The inteqer values of the 
top two items on tne stack are reolaced by their inteqer 
sum. 

ADO meagdgrdecimal).. the decimal value ‘of the 
meee item on the stack is loaded into decimal arithmetic 
register zeror and the value of the second item on the stack 
1s loaded into decimal arithmetic register one. The two 
arithmetic reqisters are added with the result placed in 
register two. The oriainal decimal values on the stack are 
replaced by the result of the arithmetic operation. 

Se GUO react = Tateger ). The second inteaer 
value on the stack 1s subtracted from the integer value on 
top of the stack, both values are removea from tne stack and 
the result of the oneration is olaced on too of the stack. 

SEO cee sWintract ~aec imal). The same action 1s 
taken as in tne ADD operator excent the second item is 
saortracted from the tco item on the stack. 

MPI: (multioly inteaer). The same action 185 


taken as in the SBI operator except tne tor two items are 
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multiolied. 

M2Oee Om) t oly decimal). The same action 158 
taken as in the ADD operator except the ton two items are 
multiolied. 

DVI: divide inteaer). The same action 1s taken 
as in the SBI onmerator exceot the top item is divided ov the 
second item. 

DVD: (divide decimal). The same action 1s taken 
as in the ADD operator except the top item is divided by tne 
second item. 

NEG: (negative). The sign of the decimal or 
integer on too of the stack is channed. 

Cll: (€convert inteaer). ites integer om too oof 
the stack 1s replacec by its decimal eauivalent. 

Elie wr CComnvert Mamtecer). The same action 18s 
taken as with CTI! except the inteaer which 158 the second 
item on the stack 18 converted to a decimal. 

BSosmcrmuecer less than). The integer value 
(ARB) 41s compared with the inteaer value (CARA). Roth values 
are removed from the stack. [f ARB was less than ARA, tne 
value one 18 olaced on the stack, otherwise the value zero 
1S olaced on the stack. 

DLSS: (Cdecimal less than). The aecimal on too 
of the stack 18 Compared to the decimal wnich 1s the second 
item on the stack. If the value on top of the stack is less 
than the second value on the stack, both values are removed 
from the stack and reciaced by the value ones, otherwise they 


are replaced by the value zero. 





GTR: (Cinteger greater than). The same action 1s 
taken as in the LSS omerator exceot a one 18 placed on the 
stack if ARB is greater than ARA. 

DGTR: (decimal aqreater than). Tre same action 
is taken as in the FLSS overator exceot a one 18 olaced on 
the stack if the second decimal item 1S greater than the too 
decimal item. 

EGL: Cinteger eaual to). The same action 18S 
taken as in the GTR overator exceot a one 1s olaceu on the 
eaick if ARB is equal to ARA, 

Detine <decimal equal to). fhe same action 1s 
taken as im the DGTR ooerator exceot a one is olaced on the 
stack if the secona decimal item is eaual to the ton decimal 
ifem. 

Jot mot coerunateeaual to). the same action 15 
taken as in the EQL ooerator exceot a one is olaced on the 
meeckx if ARR is not ecual to ARA. 

DNEQ: (decimal not equal to). The same action 
is taken as in the CEQL onerator exceot a one is olaced on 
the stack if the second gecimal item is not equal to the too 
decimal item. 

GEW: Cinteger greater than or equal EO.) The 
Same action is taken as in the NEQ@ ooerator exceot a one 1s 
Olaced on the stack if ARP is greater than or eaual] to ARA, 

DGEQ: (decimal areater than or equal tO The 
same action is taken as in the DNEG@ ooerator excert a one 15 
placed on the stack if the second decimal item iS areater 


than or equal to the too decimal item. 
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LEQ: Cinteger less than or equal to). The same 
action is taken as in the GEQ ooerator except a one is 
placed on the stack if ARB is less than or equal to ARA. 

DLEQN: (decimal less than or eaual to). The same 
action is taken as in the DGEQ overator except a one is 
olaced on the stack if the second decimal value 1s less than 
or equal to the top decimal value. 

NOT: (boolean not). This overator changes the 
result of any previous hoolean operator oy complementina the 
value of the one or zero which was olaced on the stack oby 
the previous operation. 

AND: (boolean and). This operator checks tne 
top two values left on the stack by any two previous hoolean 
operations. [Ff both values are one then both values’ are 
replaced with a ones ctherwise both values are renlaced with 
seezero « 

Ure ChOoleame On. 141s OOerator checks the too 
two values left on the stack by any two previous hoolean 
operations. If either value is a one then both values are 


replaced by a one; otherwise they are replaced by a zero. 


@. Strina Operators 
Pol ecCeamcGavemave). -ine two Strings on too of 
mre stack are combined to eroduce a new strina consisting of 
the characters of the second strina followed oy the 
characters of Grewetirs tos tring. The two Srey Se as 
are popeced from the stack and replaced by the resultina 


concatenated string. 
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Seco mesure ving tess than). ‘The same action is 
taken as in the ODLSS operator except that a character by 
character string comparison 1s made using the SS el) 
character collating sequence. 

SGTRs: (string greater than). The same action 1s 
taxen as in the DGTR operator exceot a string comparison is 
made. 

Seoul: “(strymq equal to). The same action is 
taken as 1m the DEAL onmerator exceot a strina comparison 1s 
made. 

Sin wstrmiaagunoet sequal to). The same action 15 
taken as in the DNEQ overator exceot a string comparison 185 
made. 

SGEFE@AStrima Greater than or equal tor. The 
Same action 1s taken as with DOGEG except a string comoarison 
1S made. 

Sebo CsSeminauless Cham of equal to). Tne same 
Sewicon 1S taken aS with DLEQ exceot a strina comoarison is 


made. 


f. Stack Ovoerators 
XCH: (Cexchange). The value of tne too two bytes 
on the stack (ARA) js exchanaed with the value of tne next 
to=top two hytes on the stack(ARB). 
PUPs ss (pae the stack). thebistack omointer (R4) 16 
meveag to the position of the stackpointer (FB) and Ps is 
moved to point to the next item below 1ts current position 


om tne stack. 





HUDEoad). ) The address value on the stack 
(ARA) 1$ FfFeplacecG By the two bytes pointed to by that 
address. 

DCB: (decrement block by more than one level): 
The stack pointer (RA) is decremented to the address stored 
in the block level tahle and the index to the block level 
table is decreased by the value stored in the next two bytes 
im the code area. The stack pointer (RR) is moved helow RA 
to the ton of the secend item on tne stack. 

Bie Ce lock ul evel amerement). ‘The index to the 
block level array 18 increased by one and the address of the 
Bepeitem on the stack 18 stored 1n the block level array. 

BLO: (block level decrement). The index to the 
block level array is decreased Fy one and the value of tne 
stack pointer (RA) is changed to the address stored inthe 
block level array. 

Sows CGUiet Pact Stack values). This operator 1s 
used to subtract the second value on the stack from the too 
value on the stack ustna unsianed sixteen bit arithmetic. 
The two values are replaced bv the result of tne 


Septraction. 


ge Array Onerators 
ROW: Callocate arrav storage). The numher = of 
array dimensions,s the upecer and lower odounacs of each 
dimension, and the array tyoe (inteaer, decimalr or string) 
are used to calculate the array disolacement vector whicn 185 


eeeoread on the stack prior ta allocation of storage alle tie 





actual array elements. 

SUB: (calculate the offset to a specific array 
element). The array subscript is used in conjunction with 
the displacement vector information stored at the bheainning 
of the array storaaqe area to calculate the adagress of the 
specific array element being referenced dv the suhscripted 


variable. 


fee 6 FProoram Control Ooerators 

Brose (hmeameheaesolutel!. the orograr counter” 15 
chanced to an address one less than the address reoresented 
by the followina two fytes in the code area. 

Bian armen comd) tional ). If the value on too 
Oemeecne stack is zerc, the proaram counter is chanaed as in 
BRS; otherwise the oroagram continues witn the next operator 
in the code area. 

BPA: (comouted branch ansolute). The ocrogram 
counter 1s chanced relative to the start of the code area by 
the value on too of the stack. 

MiitmGexyt tne ionteroereter}). ATT caused return 


of control to the ooerating system. 


ieorore USerators 
STI: (store integer intermediate). The inteaer 
value which 1s the second item an the stack is stored in tne 
PRT address which is the too item on the stack. The PRT 
address is then removed from the stack. 
SDI: (store decimal intermediate). The same 


Semon 31S taken as with SII except a decimal value is stored 
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im the allocated area pointed to by the address on top of 
the stack. 

Soe (store Strinag “Iinterrmediate). The same 
meevonm +s taken as in the SDI owoerator exceot a string value 
1S stored. 

Elbe mGstore  taveger destruct). The same action 
is taken as in the SII onerator excent both tne PRT address 
and the integer value are removed from the stack. 

SOD: store decimal destruct). The same action 
1S taken as tn the SID onerator except the pointer to the 
decimal allocated area and the decimal value are removed 
Mmeom the stack. 

SSD: (store string destruct). The same action 
Meme taken as in the SDD onerator excent the pointer to tne 
Strina allocated area and the strina value are removed from 


Smee stack. 


= lImput/Outecut Goerators 

wee wtGdumey. PMrPeecroqn1f1es the end of writing 3 
Mme to the console. 4 carriage return and line teed are 
output to the console via the onerating svstem. 

WIC: (write integer to console). oe eit ecer 
Value on too of the stack 1s converted to ASCII characters 
mee orinted on the console. 

WEE write decimal to console). The decimal 
mmeoe om too of the stack 1s converted to ASCII characters 
and printed on the console. 


Woe: (write St rine to console). The ASE [I 





neptima Value on top of Meee ack romp nimeed onvthe console. 

WID: (write integer to disk). The integer value 
on top of the stack is converted to ASCII cheracters and 
stored in the disk buffer allocated for the file name 
soecified in the source WRITE statement. 

WOO? (Cwrite decimal to disk). The decimal value 
Om top of the stack 1s converted to ASCII characters and 
stored in the disk buffer allocated for the file name 
smecified in the source WRITE statement. 

NOt wire strima to G1skiis The ASCII string 
characters on top of the stack are stored in the disk buffer 
allocated for the file name soecifieqd in the source WRITE 
statement. 

RCI: (read console integer). The console read 
meet er 1S Scammed for the ASCII representation of an integer 
which 1s converted into internal form ana placed an ton of 
meme stack. 

RCO: (read console decimal). The console read 
buffer 1s scanned for the 4SCII reoresentation of a decimal 
Value which 1s converted into internal form and placed_= on 
mep of the stack. 

RCS: (read console string). The console read 
buffer 1S scanned for an ASCIT string or for any series of 
Characters delimited by quotation marks which is placed = on 
top of the stack. 

heme (ceed —G1Sk imteder). Themsaisk. cuffer 
allocated to the file name appearing in the source l]anouage 


READ statement is scarned for the ASCII representation of an 





integer which is converted to internal form and stored on 
Bam of the stack. 

ROD: (€read disk decimal). The same action 1s 
taken as in the ROI operator except a decimal value 1s 
placed on top of the stack. 

ROS: (€read disk strina). The same action 1s 
taken as in the RDI operator except a strina value is placed 
Smeetop of the stack. 

RCN: (load console buffer). The current line on 
the console 1S dumped into the console read buffer and the 
m@umrent oOroeram counter 1S stored in oreparation for the 
possibility of a censole error ana the subsecuent reed to 
mecover for repeated conscle inout. 

Etieemcerror wo. console read). Lf enmarac tens 
remain in the conscle read buffer after all console read 
operations have been completed, an error condition exists 
and the proaram counter 18 reset to the start of tne console 
read routine allowing the console input to be entered again 
as necessary. 

UZ iw cist open). (ne aacdress on tep of tne 
meek OOIMmts to the allocated area for the file control 
olock and disk buffer associated with the aisk file name 
specified in the source lanauage file declaration statement. 
The file name which is stored in the file control bleck is 
passed to the operatina svstem which in turn ovens that 
Beecific file for disk inout/outout. 

Seow dis< close). the file name located in the 


mere contre] Flock cointed to boy the address of the top of 
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the stack 16 passed to the operatina system which In turn 
closes that smecific file to inout/output. 

ROB: (ready sequential hlock). The interpreter 
input/output routines are initialized to cpoerate with the 
Pepe contro! biock anc disk buffer area pointed to. by the 
adaress on top of the stack. The address of the code to be 
executed upon reachina the end of a file 1S also 
fee tialized. 

ROF: (ready random block). The same action 18s 
taken aS with RDB with the addition that the specific record 
of tne disk tile is also taken from the top of the stack and 
meer tiie control obdbitiock is set uo to conduct input/outout 
mom or to that soecific record, 

EDR: fend of recora for read). At the end of a 
read statement the remainder of the recerd is skipped. 

GP Gememot record for write). At the ena of a 
write statenent the remainder of the record 1s fillea with 
blanks and a line terminator 1S anpended to the end of tne 


mecord. 


Seeesuorout i1n@® @perators 
Povem(SUbeoutine call). Thee two bytes of coae 
following the PRU cperator reoresent the acodress of the 
subroutine in the code area. This operator Saves the return 
address at the too of memorvs DoSsSitions the stack pointer at 
the top of the first actual oarameter (see Ficure 10 for 
parameter format) ana branches to the first statement 31n the 


Subroutine. 





SAV: (save actual parameters). The SAV operator 
Pepoects the stack format illustrated in Figure 11. It 
copies the actual parameters to the top of memory and checks 
ome PCE for a recursive call and if so it coptes the PCR 
opue the tom of the stack. 

SVve° (ccooy actual parameters into forma} 
parameters). The SVe operator copies the actual parameters 
at the too of memory into allocated area for the formal 
parameters on top of the stack. 

WINIS?s (unsSave oarameters). The UNS orerator 
mmecks the PCB to see if it ts the end of a recursive call. 
If this is the case, ltINS restores the PCB from the previous 
eat | e UNS also returns the value associated with the name 
Beet ne SuoOroutine to the too of the stack. In the case of 
procedures tne returned value 1S 7ero. 

RTINS Creturn). The PIN orerator changes the 
womue of the prooram counter to the value of the return 


address. 
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Vee OnreeUS ]ONS 


This project has resuited itn the construction of a 
high=level, block=structured, aoplications oriented comniler 
for microtcomouters with 20k hytes of memorv or more. Nhen 
comoared to a fully dvnamic scheme, the stack storage 
allocation and retrieval scheme presented here apoears to 
enhance program executian speed, reduce memory 
requirements, and simolify compiler implementation. 


Timing tests with several pvenchmark proarams have been 


conducted. These test proarams were obtained from REF (7) 
and have been run with several versions”) of the BASIC 
proaramminq language. Tne results (Cexpressed as execution 


time in seconds) are summarized as follows: 


BENCHMARK NUMBER | z 3 4 =) fe) 7 
ALGOL=M lewd eid Sees oe oe: she... 4 
MITEGER BASIC ens Dies BC”) SUR ea Roa cline srs mmeeaoereY, 
STANDARD BASIC ee Pcl oro. 2 "Ac, | Ose, 34 oO 
Listings of the seven pencnmark proorams are contained rn 
Aopendix A, The reason ALGOL=-M apoears slower in the first 
pencnmark is that tne arammar reauires at least ane 
executable statement in FOP looos when compared to RASIC 


which has FOR looms which car de nothing. The resultina 
ALLOL=-M orogram executes 1900 extra assianment statements 


mmrch the BASTC proarams did not. Utherwise, the results 
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clearly indicate that the ALGOL=M languaae is not only 
wellestructured but also executes rapidly 1m comparison with 
the very best BASTC interoreters. It is believed that tne 
major reason that tne ALGOL=-“ versions performed so well is 
the fact that the lancuage supports iinteaer arithmetic as 
eeposed to most BASIC implementations which convert all 
constants and variables to flaating ovoint format. Tacs 
allows ALGOL=M loop control counters to be incremented 
extremely rapidly. Comparisons for decimal calculations 
have not heen done, and thus no conclusions can be drawn 
eemeernina relative soeeds oO f calculation=denendent 


proarams. 


a) a 





Ve. RECOMMENDATIONS 


There are several areas that could be enhanced in this 
implementation of ALGOL=“M. Formatted 1/0 although defined 
in the orammar has not been implemented. The I/O aefinition 


16 very similar to that of COBOL and implementation of this 


poulc mot he too aifficult. File I/N is implemented, put 
mo t tested. DNebuagina facilities in the run=time monitor 
are not currently imolemented. However, the svstem 1s 


aesigqgned to provide the following information at run-time: 
the line numoer of tne currently executina line ard the 
value of each variahle as it is altered. 

The currert version of ALGUL=-" its designed to run on a 
System with at least 20k ovtes of menory. A smaller system 
could oe desianed to run on a l6k system. This would 
involve deleting some of the more complicated sections of 
code such as dynamic arravs and recursive subroutines. The 
other features of the lanauage which are not imolemented are 
relatively minor, and are indicated in the Oorogram 


listings. 
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300 
400 
590 
700 
800 


300 
40V 
590 
600 
790 
800 


300 
400 
590 
50 
6090 
700 
600 


APPENDIX A 


BENCHMARK PROGRAMS 


Bencnmark Proaqram 1 


PRINT "START" 
FOR K=1 TO 1000 
NEXT K 

meant, "END" 

ENO 


BEGIN 

INTEGER A,kK; 

Alpin to eeu | Nig 

FOR fee Sieeater 2 Ol F000; 00 
7-0; 

ee enn > 

EN 


Benchmark Procram e 


eein] "START" 

K=0 

K=K +1 

mR <1000 FAREN 500 
PRINT “END" 

END 


BEGIN 

Pave Gi Sak, 

WRLTE eC STARI");> 

ee 

Wee K< 1000 DOG 
=K+1; 

Pete CC END): 

ENN 


Benchmark Proaram 3 


Seiit "START" 

K=0 

K=K +] 

A=K/K*K+K oK 

Meee ©1009 THEN S00 
ee iN? "END™ 

END 


REGIN 

PTEGEP “ASK; 
Wivtae © START” )7 
K3=Q; 
ine Ke 1000 DO 
BEGIN 

Ks=K+l1; 

NP ZK/KARK +K MKF 

END; 
Nreee (EMD) 7 
ENN 





300 
400 
500 
510 
600 
B00 
800 


500 
40\ 
5900 
510 
320 
600 
700 
800 


Benchmark Proaram 4 


PRINT "START * 

K=0 

K=K+] 

A-K/2*35+425 

TF K<1090 THEN 5090 
BRN SEND” 

END 


BEGIN 
INTEGER A,K; 
WRITE C™START"); 
K3;=0; 
WHILE K<1000 ON 
BEGIN 
Coane 
Assk/e*$44—-5; 
END; 
RIE te) 7 
END 


benchrark Proaram 5 


PRINT"STAPT"™ 

K=0 

K>=K +} 

A=K/2* 54429 

SeSsuUB 820 
Reek<1000 [HEM 500 
eetNt “END” 

END 


eho. 


REGI" 
Pitre eEe es, <, 
PROCEDURE DONUTHING,; 
A:=9; 
WRITE C START")? 
K3=0; 
WHILE K<1Q000 DO 
BEGIN 
a =i ae ed 
AseK/er5t4ne5S3 
DUNOTHING; 
ie 8) 
ieee ES); 
END 





300 
400 
430 
SU) 
510 
520 
530 
540 
000 
700 
800 


590 
400 
430 
500 
510 
520 
Soy 


540 
090 
790 
890 
820 


Benchmark Proaram 6 


PRINI "START" 
K=0 

DIM M(5) 
K=K+1; 
A=K/2% 54425 
GOSUB 820 
FOR L=l FO S 
NEXT 
Means 1 O00 THEN 500 
PRINT"END" 
END 


BEGIN 
INTEGER A,K,L; 
INTEGFR ARRAY Mfi:5]; 
PROCEDURE OQNOTHING; 
REGIN 
s=9; 
END; 
Werle SAR TS i; 
K:=0; 
Weite K<1000 DG 
REGIN 
s=K+i1; 
2=K/7P*%3+4 25; 
DONOTHING; 
BOR wits tl Stee) Utes > DO 


=O, 
ENO; 
WRITEC"END"); 


itl 


Benchmark Proaram 7 


ERIN> “START” 
K=0 

DIM M(5) 
K=K+]1 
A=K/2%5t*4 25 
GOSUB 820 

BOR L=1 19 5 
M(L)=A 

NEXT L 

m  K<1000 TREN S00 
PRINT*END" 
END 

RETURN 


REGIN 
INTEGER A,«,L; 
INTEGER ARRAY M{13S)3 
PROCEDURE NONOTHING,; 
BEGIN 
iee= Ou, 
END; 
VR ETE CE START”); 
K3=0; 
Witee es <1000. DN 
PEGIN 
Kite K + 1; 
s2K/2*%3+4=-5; 
DONOTHING; 
Poet eoyer PeUNTTIL. S&S OC 
M{(L}<3=A; 
FENN; 
BeRitecPEND” )-> 
END 
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AS 


DE 


OD 


ID 


10 


i 


NG 
NI 
NP 
NS 
Ee 
50 
Sl 
TD 
T {A 
TO 
15 
UD 
UF 


UP 


waeeloinwee = = COMP IEER TERROR MESSAGES 


Function/Procedure on left hand side of assignment 
statement. 


Incorrect bounra pair subtype (must be integer). 


Disk errors no corrective action can be taken 
in tne orograr. 


Doubly declared identifier, label, variable etc. 
Invalid soecial character. 


Suotyoes incompatinle (decimal values can not oe 
assigned to integer variaties). 


Integer overflow. 


Identifier is not declared as a simole variable or 
Lumet 109. 


No ALG file found. 

SUDEYOe 15 Mot Intecer. 

No aoolicaole production exists. 

Subeyoe Vs not Sstrina. 

Undeclared oarameter. 

Stack overflow. 

pita eSuOSerYCt 15 mot Of SUbtyme integer. 
Subtype has to be integer or decimal. 
Ssubtyoes do not match or are incomoatible. 
Symbol tahle overfiow. 

Undeclared subtserioted variable. 
Undeclared iagentifirer. 

Uncectared fite/funetion. 


Undeclared oreccedure. 
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VO VanGmetacie overtiaw. Possibly caused by too many 
long. Toenti fiers. 
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AB 


AZ 


cE 
DC 


DW 


eae 
10 
NI 
GV 
RE 
KU 


SL 


II 
a 


20 


PPC ome tN TERPRETER ERROR MESSAGES 


FRROR MESSAGES 


Array suoscrict out of bounds. 


Attempt to allocate nul! 
default to 10 digits/characters. 


Disk file close error. 


Disk file create error. 


Disk file write error. 


Division by zero, result 


Disk wend of file, no action specified. 


Integer overflow. 


decimal 


set 


to 


No INT file found on directory. 


Overflow during decimal 


Attemot to read past end of 


Attemot to random access a nonwblocked file. 


Siam? Preamt digits lost durina decimal 


value set to 1.9. 


WARNING MESSAGES 


levabrva Console Inout 


Nonesignificant digit 


last sdurnag deci mat 


or strina, 


oUt 


multioly. 


record on bplocxea file. 


Characters lost durina string store. 
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APPENDIX D ALGOL=M LANGUAGE MANUAL 


This section deere piinas the various elements of the 
ALGOL*M Jlanguaae. The format of the element will be shown, 
followed by a descriotion and examoles of use. The 
following notation is used: 

Braces {} indicate an ootional entry. 

A vertical bar | indicates alternate choices, one of 

which must appear. 

Beevoses “sa... Indicate that the oreceding item mav 

pe optionally repeated. 

Reserved woros are indicated by capital letters. 

Reserved words anc other special symbols must appear as 

Shown. 

Items anpearing in small letters are elements of the 


l}anaquage which are defined and exolained elsewhere in 


the lanauage manual. 
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arithmetic exoression 


ELEMENT: 


aritnmetic exoression 


FORMAT: 


integer:decimal 


variable 


i€} arithmetic expression binary ooerator 


arithmetic exoressio0n {)} 


{(} umary omerator arithmetic expression 1{)} 


DESCRIPTION: 


Ooerators tn ALGOL|=M have an imolied orecedence which 
1s used to determine the manner 1n which operators and 
operands are arouved. A-B/C causes the result of 8B 
divided Byes CC be subtracted from A. imiethis ease @ 
Nomeomsidereo to be “bounc" to the "/" opnerator 
imastead of the "=" onerator which causes the division 
to be performed first. The implied onmrecedence binds 
orerands ee) the adjacent operator of hiahest 
orecedence. Tne imolied orecedence of ooerators 1S as 


fe lows: 


7 | 





Oniaicy acest 
xx 
ras 
+,° 
Parentheses can be used to override 
orecedence in the same way as they 
ordinary alaebra. JTnhus the expression 


the imolied 
are used In 
(A-B)/C wil] 


cause 8B to be subtracted from A and the result divided 


oy C. 


EXAMPLE: 


renter t oe XO Ce * Y + X) ** @ 


Peete eck Xk YY & 7 / 5.456 + | 


joe 





ARRAY geclaration 


ELEMENT: 


ARRAY declaration 


mormMAT ¢ 


INTEGER! DECIMAL!STRING {Cexoression)} ARRAY 


maent ir fier «2. Found ocair list {,identi fier} 


BescRIPTION: 


The array declaration dynamically allocates storage 
for arrays. The optional integer expression indicates 
Gremrenath of each arrav element. For strinas, the 
maximum length is 255 characters and for decimals the 
maximum lemath +s 18 digits. Integer lenaths are not 
specified since storace adequate to represent al! 
integer values hetween e100, 584 ana tlo, 584 1S 
automatically allocatea. Arrays are not automatically 


Mant alized. to zero. 


EAMPLE: 
PHTEGER APR&Y X(0:35,0:5); 
PeCiMALT ID ARRAY xX,Y15:6,5:10) > 


STRING ARRAY WORDS LY+3: 12); 


assignment statement 


ELEMENT : 


assignment statement 


FORMAT: 


Vwoerraole= s= ivariabdle ¢=} ... exoression 


moc kKIPTION: 


The exoression 1s evaluated ana stored Into the 
variable. The types of oermissible assianments are 
indicated by the followina tables: 


expression 


mteger decimal String 


integer 


variable decima]) 


strina 





Multiole assianments are allowed with the exoression 


being assigned to all of the listeg variables. 


EXAMPLE: 
Maetc=enyY c+ 7; 


eum ao yet. s= 50> 
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Daranced statement 


ereeMeENT : 


balanced statement 


FORMAT: 


{label definition}! simple statement 


{label definiticen} IF boolean expression THEN voalanced 


statement ELSF balanced statement 


MeoeRIPTION: ° 


Lt the hoolear expression 1S true, the balanced 
Statement to tne teft of the ELSE is executed. If the 
boolean expression is falser the balanced statement to 


the right of the ELSE is executéd. 


EXAMPLE: 
: pees hee deN A 8 = 1 ELSE f := 2; 
tees = se THEN 
REGIN 
WRITE (B)3 
Bees een 1G 
END 
Bee 
REGIN 
WRITE (C)3 
Gees 3G oe 1; 
END; 
PROGRAMMING NOTE: 
A semicolon Ve iavelie allowed after the statement 


(As 





immediately preceding an ELSE. 
in 
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oS ae 
“5007 we Drips: 


; = 
= 





bi ock 


ELEMENT: 


Soc « 


FORMAT: 


DMNA Oee loarat) On; ) «2. Statements, ... END? 


MeoCRIPTION: 


The onlock is the foundation of tne ALLOL=-M languaae. 
Each time a new block is entered new variarkles may be 
declared. Jnese variables are uniaue in the sense 
that a varianle xX declared in two different blocks 
represents two different variables. Al} storage 
within a block is dynamic ang allocated when the block 
is entered anc aerallocated when the block 1s 
departed. A trlock can he used any place a simple 


statement can de used, 


BeOAMPLE 


Zz 


tM -— 
we 6 


we G8 de 


™m 
= m 
J ee ef G) 


m—-~< 


|e lead an 


i 
a 2) 
mn» 
ee G) 
pid, 
& wi 


=e %OB6 


mMm< «— Dd 
a 

7) +0 

we UF Ub me 


PROGRAMMING NOTE: 


WT 





Declarations may not apnear in case blocks. \invs: 32 5\Teley 
END, which matches the initial orogram BEGIN, is not 


followed by a semicolon. 







_ 








ae 


. . » = oo 2 
ferve? sf «?P’30!0 3769 cl %e8ec04 FO" ver 


TA 2 
mm ( : -"* #*£°700 96 lia°T*or any feHsiem 





-1° 1 Parnes Be 


- : 


boolean expression 


SEeeMENT: 


boolean expression 


FORMAT: 


NOT boolean expression 
ooolean expression OR poolean expression 


boolean expression AND hoolean exoression 


{(} expression =;<;>;>=:<=;,<> expression {)} 
MEoCRIPTION: 
Integerwtinteger, decimalwsinteaer, cqecimalwaecimal, 


integer-decimal,s, and Sstring=Strina’ comearisons are 


allowed im ALGOL=™, For inteaerw-decimal and decimal- 


integer comparisons the inteqer value 1S converted to 


a coecimal value perior to comearison. The result of a 


comparison of numerical values 18 based on the s$17e of 


the numbers. The result of a COomoanr) son o f 


strina 


values depends on a characternwbhyn-character comparison 


where the first instance Ot 3 non-e0ua] character 


establishes the boolean PeSult. TRe collating 


Seaagwemcemor the BAosCll character set 18 usec for strina 


comoarisons. Generally, numoers are followed ov upoer 


case letters which are followed by lower case letters. 


EXAMPLE: 


TS 





Keer rR: ¥Y < 7; 
eee eNO CY = 7 OR 27 = 10)3 


eee yexs= 1 THEN WRITEC"RELLO"); 


—, 


RY 


a 
v . : 





-_— 
= 


= : 
= “ay S = ¥9 


a | 






I ” nV 4H r = 5 


Douad pooair 17st 


PLEMENT: 


bound pair list 


FORMAT: 


fexoressicn : expression{,expression *: expression} ...] 


PeocniPTION: 


Expressions in tne bound pair list must be of tvpe 
integer and areater than or equal to zero. There can 


ne no more tnan eSS dimensions. 


EXAMPLE: 
Glee 7 73 5) 
oO px ey} 


yo s 2 1s be) 


R | 





CASE statement 


ELEMENT: 


CASE statement 


FORMAT: 


CASE exoression OF 
REIN 
StESCeOMENL + <0 


FND; 


DEoGckIPTION: 


The CASE statement allows the oroarammer to chose one 
of several statements to be executed. The statement 
chosen deoends con the value of the inteaer exoression. 
The first statement is executeaq if the expression 
evaluates to zero. If the vohee of the expression 15 
Greater tnan the number of statements in the case 


block, Giemresultimag action is uncefined. 


EXAMPLE? 


PASE xX 2+ Y NF 
REGIN 
WRITE U"GCASE 0%); - 
role ee Ste)! ) | 
END, 


me 





CLOSE statement 


SeeMeNT : 


CLOSE statement 


FORMAT: 


Cielsemicemt miienmeet, 1 aentifier} <«. 


DESCRIPTION: 


This statement allows the proarammer to explicitly 
@moscecurthe mariie imdicated. Closina a file results in 
Gmenwtvie Ferma rewound (1.e., if 1t 1S reopenedac the 
Melee qins ae the first record). <Any nurber of files 
may be open at any one time. All files are implicitly 


closed at the end of the program. 


EeeAMPLE : 


MBOSE er IEEly FllLec; 


R% 





Cons tant 


SBEMENT: 


constant 


FORMAT: 


integer;:decimalistrina 


PescrIPT(ONn: 


A constant may be either an integer, aecimalsr or 
String constant - Integer constants are numbers with 
no decimal ooint ranaing from -16,384 to +1lo0,5R4, 
Decimal constants are numbers with a decimal voint and 
may not exceed 18 digits in lenath. String constants 
may be composed of anv comoination of alohanumeric and 
special charaters and may be up to 255 characters in 
lenath. Strines enterea from the console or disk may 
be either enclosed in auotation marks or delimited 
with blanks. Strinas used as constants 1n the program 


must be enclosec tn quotation marks. 


EXAMPLE: 
10 
N02 5075 


PEXSMPLE ONE™ 


Rif 





declaration 


ELEMENT: 


deciaration 


DESCRIPTION: 
See FILE declaration, ARRAY Gee larat ion, simple 
declaration, crocedure declaration, and fume t 1 OM 


ceclaration. 


an) 





exoression 


ELEMENT: 


expression 


FORMAT: 


boolean expressioni:iarithmetic expression 


PeseRIPTION: 


see arithmetic exoressian and boolean expression. 


Ro 





PIEE “declaration 


ELEMENT: 


mlimee declaration 


FORMATS: 


FILE igentifier (Cexoression)} {,iaentifier 


NY 


meexeress tom) )})..< 


BeseRIPTION: 


The identifiers used in the FILE declaration are file 
identifiers wnich reference actual file names. The 
actual file names may be assianed at comorle-time or 
at rune=time. The ootional inteaer exoression 
following the file identifier 1s used to soecify the 


mecora length im bytes for Flocked records. 


me AMPLE ; 


pote ACE ly 12PEe( lea), 


‘er 





FOR statement 


ELEMENT: 


FOR statement 


FORMAT: 


Manele derinmyrtiem: FUR assienment statement 


" {STEP expresston} UNTIL expression NO simole statement 


meocRIPTILON: 


Execution of all Statements Wale Ton the simole 
Staterent are reoeated until the indexina variaodle 1s 
greater than or equal torasthe Value. of the UNTIE 
expression. The indexing variable is incremented by 
the amount specified in the STEP exoression and *must 
be incrementea by a rasitive amount . The UNTIL and 
STEP exoressions are evaluated on each loop. Tf the 
optional STEP expression is omitteds a default value 


Sreone -1s used. 


EXAMPLE: 


BEOit Ser aN, 1 0 


mOiiciOe x= X +0 Y HNTIL X * Y¥ OO 
bEGIN 
Kees hae?) > 
WRITE CA); 
EO 


RB 





func t yom, Cal} 


eeemMeENT : 


munetron cal | 


FORMAT3: 


identifier {Cexcression {s,exopression} ...)} 


Pe ocRIPTION: 


FUNCTIONS May aovear as Primary elements in arithmetic 
or ooolean excressions. Farameter oassina 1s by 
value. Functions may oe called recursively with no 


inomat tol Tne nurber of recursive calls allowed. 


tes- Pf UIC * RND(2); 
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function declaration 


BeeEMENT >: 


fume trom odeciaration 


FORMAT: 


INTEGER! DECIMAL! STRING FUNCTION identifier 
Geacdentirrer {,idemtifiert ..<.)} 


~eclharatiom, «..!f Simole statement > 


Den5eKkiPTION: 
A function declaration may or may rot include 
parameters. I parameters are included they must be 


declared before the simole statement which represents 
the body of the function. Parameters are oassed by 
value and may be of type inteaer, decimal, or string. 
DUmetroenms  returm a value toa the point of call. The 
value to be returned is assigned to the function name 
(which 1S usec as a simple variadle within the 
Binet yOm) sOrIOG to the end of the function. Functions 
may be called recursively with no limit set as to tne 
maumeenrnor recursive calls which can be nade. Variabdles 
may be declared witnin functions and are considered 


Moea! to the furction. 


ma eMPLE: 


Pilecer FUNCTION VALUE(Y)-: 


90) 





7 _ 
7. 
INTEGER X; 
BEGIN 
Kear (xe 5) 4 CX * C i); 
VALUE 2s X; 


eh 








GOTO statement 


ELEMENT? 


GOTO statement 


FORMATS: 


laoel definition GO TON identifiertinteger 


lapel definition GOTO identifierjintecer 


MeooRIPTION: 


Execution continues at the statement labeled with the 
identifier oor integer tfollowina the GOTO or GQ TO 


Statement. 


EXAMPLE: 
Mirx ie GO 10-100; 


moO GOTO NEXT; 


PROGRAMMING NOTE: 


GATTO statements can only be used to oranch within the 


GSurreme lm |OcK Of fo an outer bliock. 


aie 





identifier 


eeEMENT: 


identifier 


FORMATS: 


letter {letterjnumoer} ... 


DESCRIPTION: 


[Identifiers oegin with a letter and are continued with 
any alonanumeric characters. Ayrnouan identifiers uc 
Homes onecnaracters may  6e Used, only the first | 


characters are actually used to distinguisn the 


identifiers. 


EXAMPLE: 
A 
NAME 


COUNTER1 


23 


IF statement 


BeeEMEN] s 


IF statement 


PESCRIPTION: 


see balanced statement or unbalanced statement. 


a4 





lapel definition 


ELEMENT: 


label definition 


FORMAT: 


identifierjinteaer : 


PesORIPTION: 


Label agefinitions are optional on al} balanced or 


unovalanced statements. 


EXAMPLE: 
PaINtSHs 


Loo: 


o> 





orocedure cal! 


BEeMENT ¢ 


Sroceaquece cal | 


FORMAT: 


identifier {(Cexoression {-,expression} ...)} 


MescRIPTLION: 


pracedures cam me called with or without Marameters. 
Parameter oassina VS ey value. Procedures can ode 
called recursively with no limit set as to tne number 


of recursive calls. 


ScaMPte : 
COMPUTE; 
COMPARE( "AAA", WQRD); 


COUNTC1, e, 3); 
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procedure gaeclaration 


ELEMENT: 


orocedure dectaration 


FORMAT: 


PROCEDURE jidentifier {Cidentifier {,identifier} ...)} 


{declaration;, ..--} simple statement 


PeseRIPTION: 


Meerocedure declaration mav or may not ine huae 
parameters. If parameters are incluaed they must be 
Geclared before the simole statement which represents 
the body of the procedure. Parameters are oassed by 
value and may ve of type intener, decimal or String. 
pRocedures do mot return a value to the potnt of call. 
Procedures can te called recursively. Procedures are 
considered Secarate olocks Mla tea when. local 


variables may ve declared. 


EXAMPLE: 


PROCEDURE OUTPUT, 
Wiel =e) (°RELLO"); 


BeOteOUR Ee COMPARE (X,Y); 
etait 9% >, Y 7 
BEGIN 
Nelle the CARGEST [NIEGER 1S *); 
TF K > Y TREN 
Pere Cx) > 
Eto 
NeTTeE CY); 
END; 


STi 





READ statement 


ELEMENT: 


READ statement 


“= 


FORMAT: 


menue yariadle {,variable}? ...) {ONENDFILE block} 


Peal KIPTLON: 


If the form of the READ statement is PEADL, then the 
input device is the console. Qtherwise a file ocetion 
must be specified and the input cevice is the disk. A 
READ statement reads one or more variables at a time. 
The optional ONENDFILE section indicates action to oe 


taken when the end of the soecified file 1s reached. 


SAMPLE: 
READCWORDONE, X, VALUE2); 


RPEGODwE PLES (NORDONE, X, V4LUE2); 


PROGKAMMING NOTE: 


The ONENDFILE section i8 curently not implementec. 
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reserved word list 


Se MeENT : 


reserved word list 


FORMAT: 


fetter {letter} .<. 


BeacriPTION: 


The following words are reserved by ALGOL=M and mav 


mae oe UuSeG as identifiers: 


AND ARRAY BEGIN CASE 
CHOSE DECIMAL DO ELSE 

END EXTERNAL pees FUNCTION 
GO GOTO LIS TNITTAL 
INTEGER NOT Oe ONG NDE Tie 
UR eG PROCEDURE RcrAD 

STEP STRING TAB THEN 

T9 UNTIL WHILE WRITE 

iP ITTEON 


Reserved words must be oreceeded Ean. followed ON 
either a special cnaracter or a smace. Soaces may not 


one embedded within reserved words. 
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Ssimnole statement 


BEEMENT: 


simele statement 


FORMAT: 


block!iassignment statementifor statement} 
case statementiclose statement;iaoto statement} 
while statementiread statementiwrite statement, 


procedure calliidentifier 


MeockIPTION: 


All ALGOL@MH statements are free orn ene must ode 


separated by semicolons. 


100 : 





simole declaration 


FLEMENT: 


simole declaration 


FORMAT: 


mipeGer, OECIMAL {STRING {(Cidentifier!tinteger)} 


poentyfier {,identifier} ... 


PeoCRIPT ION: 


Simole inteaqer variables may be any value bhetween 
“160,584 and +16,584. Simole cecimal variables can be 
SOEecified as anv length from one to 18 diaits with 64 
default emdthwes 10 “digits.  oImole string vaeriravles 
Gam 96 soecified as any Jlenath from one to 255 


characters with a default lenath of 10 characters. 


EXAMPLE: 
Dire GER XxX; 
DeCraaiL 6 ]S)> xpy: 


STRING( 33) WOSDONE, ADORDTWO, WORDTHREE; 


10] 





SocCCi oa coaracters 


ELEMENT: 


SAoeCciai characters 


De seRIPTION: 


The following scecial!l characters are used by ALGOL=M; 


( oven oarenthesis 
) close parenthesis 
x asterisk 

it plus 

= minus 

; colon 

; semicolon 

< less-than 

> gGreatern-than 

= equa] 

, comma 

{ ooen bracket 

} close oracket 


>= assignec equal 

ke exponentiation 

he percentage 
Any smecial character in the ASCII cenaracter set Mmav 
aoOpeag te a StrIne. Specie! characters, other than 
Mpecem 1stea above, wil! cause an error condition  1f 


mGegmoutsi de of a strina. 
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TAB expression 


ELEMENT: 


TAB expression 


FORMAT: 


TAB expression 


BeoerRiIPTION: 


iors oOtyonally used in a WRITE statement to cause 
SoaGing on the outcut line. thevamount of spacing is 


specifieaq pv tne inteaer exrcression following JAb. 


EXAMPLES: 


WPITEC"NEXT NAME", TAR S, NAME CTI); 


i) 





unbalanced statement 


feeMeENT : 


unbalanced statement 


FORMAT: 


{label definiticn} IF boolean expression THEN statement 


{label definition}! IF boolean expression THEN vdalanced 


Statement ELSE unbalanced statement 


Boe RIPTION: 


Unlike the balancea statement that will always have a 
Bollenced statement on either side of the ELSE 1m an IF 
THEN ELSE Structure, an urbalanced statement may not 


even include tne ELSE portion of the statement. 


EXAMPLE: 
Meee oe Y THEN WRITE (CX); 
IF xX < Y THEN 
oeceroey fae ly 
nk hE CZ} 


ELSE 
WRITE(X); 


PROGRAMMING NOTES 


A semicolon 1S) not allowed after the Statement 


immediately preceding an FLSE. 


1nd 





variable 


FLEMENTs: 


variable 


FORMAT: 


maemtirier {tbound oair lst) } 


BeocriPTlON: 


A variable in ALGOL@=M may be simple or subscripted and 


DvOocm LI EGER, DECIMAL, or STRING. 


EXAMPLE: 
x 
Veabve fe) 


POX Y) 





SeeMeENT: 


WHILE statement 


FORMAT: 


WHILE boolean exoression DO 


BeoorIPtlOn: 


WHILE Statements Continue 
staterent follecwimae the VU 


expression 1S true. 


EXAMPLE: 


0 DO 


ARLE | 
ee el; 


es V 


Meee § > 5S AND ¥Y <> & DO 
BEGIN 
Aes ot: / 5; 
Wee Pe CX.) ;> 
eS NTOR 


WHILE statement 


simole statement 


execeut yng 


for as 


long 


the simonle 


aS ene. woo lean 





WRITE statement 


ELEMENT: 


WRITE statement 


FORMAT: 


WRITESWRITON {file ootion} 
(exoression;tao expression;oic definition:strina 


Weex%OPeSsiOn, fae exoressiom Cic definition:strinc! ...) 


MeoeRIPTION: 


Pae WRITE  Ggotvicn Indicates the output will start 
printina on anew liners while the WRITEON option will 
continue orinting on the same line. Lt "the Vitormaros 
the statement 1s WMRITE(C or WRITEON(, the output device 
is the console. Otherwise, a file ootion must 0obde 


Seecywrred amo the oetitout device 1$ the disk. 


EXAMPLE: 
WRITECX); 
eee te NUMBER [S",xX + YY); 


Tbe ANS Wer »  12B S, xX -« Y)3 
PROGRAMMING NOTE: 


The PIC definition is not currently implemented. 


Os 





APPENDIX E ALGOL=M LANGUAGE STRUCTURE 


In the followina sections, the syntax of the lanaquage 
meee oe )6ChdFcisted 6 6in€6BNFUnotation followed by the semantic 
actions (offset with asterisks) associated with that 
mmoauction. em aeS em iota or Davee ee SOlVven in terms of 


comoiler oaata structures and the ALGOL*“ machine code 
generated. Items enclosed in brackets and separated by 
Slants are alternative semantic actions. N/A indicates no 
eer 1on. [Dismeootathemsls similar to that used in PEF 6 and 


eee 10. 


1 <program> ::= <block> <-'= 
k<plock>; xT7T3 {eof indicator} 


emcolock> ; 
k<bdlock 


@ 
e 


= <hlock heada> <block ena> 
hegd>;s <bplock end> 


3 <block heaa> 


Te = eb loOeck neaGe <cdecliaration> -; 
ReOoG ma Nead>, 


<declaration> 


4 ; Shearn> 
zx<block> 


6 <block end> ::= <hlock hody> 
*RLDPD 


Dd 
= 
oe 


mesa loec< Fody> ::= <statement> 
x<statement> 


8 <block body> ; <statement> 
k<plock bodv>: <statement> 


MEO JeCGibanacrome 2:22 sfile declarstion> 
x<file declaration> 
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10 


lel 


iG 


es 


14 


15 


16 


ey 


14 


19 


e0) 


cl 
el 


aS 


e4 


eo 


<i t Ila aeoe CilOm> 4 


; <simole declaration> 
zk<simole declaration> 

mas pl er oeclaration> <imitial ootion> 
k<simole declaration>?: <initial ootion> 

+ <arrayv declaration> 
k<array declaration> 

i <array declaration> <initial option> 
k<array declaration>; <initial option> 


' <€subproaqram declaration> 
x<suborogram declaration> 

;> <external declaration> 
zx{Not implemented} 


<Simore Geclaration>= <%= <declaration heada> 


<iaqenrifier> 
x<declaraticn head>: LIT fidentifier adgdress} 
kLTALD/ALS/ N/A for jinteaers]) 


*= <initial head> <constant> ) 
k<inmnitial nead>-s <constant> 


SNe meneac> o2i= samt 1a) 


N/A 


; <initial headg> <constant> , 
e<initial nead>; <constant> 


€declaraticn head> ::= <declaration tyoe> 
k€declaration tyoe> 


' <declaration nead> <idgentifier> 
f 
k<aeclaraticn head>; LIT {identifier address}: 
*{ALD/ALS/ N/A for inteaers] 


“—“Heciararvicenm types s:= strina 
eIMI {strine default size}; 


' string <size ootion> 
k<Ss1Z22 optican> 

; Integer 
NZA 

1 Gecimal 
*IMi {decimal default size}; 
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26 


27 


28 


29 


50 


oy 


3e 
a 


55 
59 


34 


Se 
55 


Sie 
56 


oy 


58 


59 


4 0 


~ececimal <Size opt ion> 


k<s1Ze optian> 


<siz2e .OCt1on> <% ( <variable> ) 
*LITLOAD {variable address}; 

© € <integer> ) 
k<integer> 


<staterment> :$:= <balanced statement> 
k<balanced statement> 

' <unbalanced statement> 
x<unbalanced statement> 


“pallameced Statement> 3::= <simple statement > 
*<simole statement> 


' <if eclause> <true oart> else 
<balanced statement> 
RewieGiause>;, “true Carts, <bDalanced statement > 
(eel jbe leer 1 191t) on> 
<balanced statement> 
k<label definition>-s <oalanced statement> 


“umoaabanecec statememt> <= <if clause> <statement> 


*<if clause>; <statement> 


; <3f clause> <true part> 
else <unbalanced statement> 
k<if clause>; <true part>: <unbalanced statement> 


Peclebelwdetinttiona> 
<unbalanced statement> 
x<lapel definition>; <unbalanced statement> 


<true ocart> ::= <balanced statement> 
k<oalanced statement>; BRS fadoress of end of 
kcurrent statement } 


<lape|] definition> i:= <identifier> 3 
N/A 


m~sinrecer> : 
N/A 


<p oc k> 


<simole statement> 
5 S10) Ilo le er 





4] 


4e 


43 


44 


45 


46 


47 


QR 


49 


50 


Sy! 


ara 


52 


25. 


54 


Ss 


56 


Sit 


<assignment statement> 


; <assianment statement> 
k<assignment statement> 


: <for statement> 


k<for statement> 


; <wntile statement> 
k<while statement> 


1 “<read statement? 
x<read statement> 


+ “write statement> 
k<write statement> 


» SCase statement> 
*e<case statement 


© “ECD to statement> 
x<go to statenent> 


» <close statement> 
x<close statement> 


i “<orocedure call> 
k<procedure call>?; PRO, 


; <1aentifier> 
kTM2 {subroutine adadress}7 PRO; POP; 
2::= <jeft part> <exoressi1on> 
k<left part>; <exoression>:s (SII/SIPD) 
mw «left oart> 


<assranment statement> 
e<left mart>s <assianment statement> 


Seo tprmoarto. :!'=s <VYariabole> < <= 
aA<yvariable>-,s (fLTT/LITTLOQAD) 


<exoression> 3:5 <arithmetic expression> 
k<gritnmetic exoressi1an> 
' <if expression> <expression> 


N/A 


<agrithretic exoression> :3= <term> 
x<Cerm> 


+ “<arithmetic exrpression> +t 





Si 
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ae 
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Se 


60 


6 | 


oe 


63 


64 


65 


66 


67 


68 


67 


70 


eA 


(ts 


<term> 
koarpjtmmet ie expression>, <term>; [LADI/ADD} 
; <arithmetic exoression> 
<term> 
k<arithnetic exoression>; <term>;, [SBI/SBD] 
i <arithmetic exoression> 
; + “<term> 
zx<arithmetic exoression>, <term>; CAT; 
; @ <term> 
ke<term>; NEG 


; + <term> 
xk<terr> 


<term> = <orimaryv> 


k<primary> 
| —<term> * —<primary > 
k<€term>; <primary>; ([(MLI/MLD] 


; <term> / <orimary> 
k<term>; <primary>; (DvI/DV)D] 
<oprimary> 2::= <primary element> 
k<primary element> 
r <primary> ** <primary element> 
k<porimary>; <orimarvy element>; JXP 


<primary element> ::= <variable> 
kLITLOAD {address of simole variable}/ N/A for 
ksubscriotec variables/ IM2 {subrountine 
kaddress in code areahs PRO 

i S€oems tant 
k<constant > 


PesCROceaure ca) l> 
k<procedure call> 


; € <assignment statement > 
*<assignment statement > 


; € <exoression> ) 
k<exopression> 


“COMMS tamts ss = <'hteqer> 
*INT; {constant} 


ic 


) 


Tie. 


74 


iis) 


ee 


78 


79 


80 


81 


82 


8% 


84 


ole) 


86 
56 


3 <decimal> 
Cele  1conms tant} 


eo SSteiag> 
xSTR; {constant} 


<variable> ::= <jidentifter> 
NA 


' <subscripted variable> 
e<suoscrioted variable> 


<fyile declaration> ::= <file nead> <file name> 
x{not implemented} 


<files head i2= f4 le 
k{not implemented} 


' <fjle heaar> <file name> ’ 
k{not imolerented} 


SP ilewmames= nm: s= <Sstrima> <lemoth oot1on> 
t{not implemented} 

; <strinap 
k{not imolerented} 


' <identifier> <length ootion> 
k{not implemented} 


1 <identifier> 
cme te imo lerent car 


<lenath ootio0n> s= { <identifier> ) 


zx{not implemented} 


you —<!mtecger> | 
{not implemented} 


<array declaration> ::= <array jist> 
<bound pair list> 

Reqerayusliste2s ——<DOouUmMd Oar 11St>; 
eens Ot anrrtays(m)>s LIF {type af 
SA): 
zkfollowed bv: 

ie Meieewamnay.)) ocat ont 

(2) m=me-l if m=0 then halt else steno(t) 





87 


88 


89 


90 
90 


21 


a5 


94 
94 


a5 


96 


a1 


98 


99 


100 


Ue 


Saepayelist> »«:= <array head> <identifier> 
a<array head> 


<array heaec> 3::= <deciaration tyoe> arrav 
k<declaratican tvpe> 


' <arrav head> <identifier> , 
k<array nead> 


<bound pair J]1st> $3:= <bound pair head> 
<“powmd Oaie> 7 
*<bound pair head>; <bound oair> 


11 
_ 


<bound pair head> $3: 
N/A 
' <€bound oair head> <hound oair> 
k<opound pair head>;z <bound oair> 


<D0uNnG oair> 32: <exoression> : <expression> 
k<exoression>; <expression> 


<suoscrioted variable> ::= <subscript head> 
<exoression> ) 

kK<€suboscriot head>; <expression>, 

MEL TEOAD <array address>, SUE 


“suopceri@t Nead> ¢:= <i1dentifier> [ 
NZA 
i; “<subscript head> <expression> , 
*<subscriot head>; <exnression> 


woGomtOuestatememt> i2= <Ggo to> <identifier> 


tDCB {2 of blocks to decrement} /NOP?NOP 
tfollowed bv RRS {branch aadress} 


mexico fo>  <integer> 
‘Dei e Or Slocks to decrement} /NOP?NOP 
tfollowed by RRS {branch address} 


Gdomtoer «<= CO to 
NZA 


a salle) gre, 
NZA 


<read statement> 3::= <readg nead> <variabdle> ) 
k<read heaa>; LIT/LITLOAD taddress of variable}; 
ARO ee ls SiO7S0D/SSD 

aunmcomaole 1/0 then ECR 


i 


Ld 





102 <read head> ::= read ( 
*RCN 


103 ; read <file ontion> 
{not implemented} 


104 ' <read head> <variable> , 
x<read head>; same as production 101 


105 <write statement> ::= <write head> <exoression> ) 
x<wrejite head>; <expression>, [{WIC/wDOC/WSC/wID 
kWOD/WI1D) 

106 ; <write head> <tab expression> ) 


kt{not implemented} 


LUs ; “write head> <pic definition> ) 
kx{not implemented} 


108  <write head> ::= write ( 
x MP 

109 ; write <file ontion> ( 
*{not imolemented}) 


110 7 owe) Geon) ( 
N/A 
ii ; writeon <file ootion> ( 


x{not implemented} 


112 ; “write head> <expression> , 
k<write hnead>; <expression>; [(LIT/LITLOAD]) 


el 3 ; “<write heac> <taod expression? , 
zx{not implemented} 


ee + “write heaa> <pic definition> , 
k{not implemented} 


1h ae) “file —Opticom> °:= <ydentifyver> 
NZA 
116 ' <identifier> <rec ooption> 
N/A 
el 7 1 <string> 
N/A 
118 : <strina> <rec option> 
NZaA 
119 €rec ootion> 3:5 , <icgentifier> 
N/A 





120 


Wal 


ee 


hes 


124 


eS 


te © 


ee 7/ 


128 


1e9 


Ve 
oe 


1S 1 


ic 


es 5 
eo 3 


134 


oe 


56 
Ee, 


N/A 


, ~e <Integqer> 


Seo et i mit tOmoss= <OYC head> <pic list> ) 
k{not implemented} 


<pic head> ::= pic <string> 
kt{not implemented} 


' pic <identifier> 


x{not implemented} 


Soe bist> -32=. ( 
x{not implemented} 


<expression> 


ECoG mmllst> wepuecexOress 1OMm > 


k{not implemented} 


<tab expression> ::5= tab <exoression> 
k{not implemented} 


<if clause> 


k<boolean 


*s:= if <boolean exoression> then 
exoression>; RSC {ovranch aodress} 


“yet WeExXxOPesSsSiome %<2-= <1f clause> <exoression> else 
k{not implemented} 


<poolean 
k<boolean 


x<DboOO!esn 
<boolean 


zx<boolean 


x<hoolean 


zk<poolean 

<bpoolean 
k<logical 
kt<poolean 


<logical 


<hoolean term> 


expression> $3 
term> 


; <hoolean exoression> or 
<boolean term> 
expression>; <poolean term>; ROR 


term> 3::= <boolean orimary> 
primary> 


enol ecooolean Ofrimary> 
orimary>, NOTO 


; <boolean term> and 
<boolean primarv> 
term>; <boolean primary> ANDO 


Srimarye <logical expression? 


exoressian> 
' € <boolean excression> ) 
expression> 


expression> :$:= <exoression> <relation> 
<axoression> 


k<exypressiom>; <expression>; fstrina, integer, 
kor decimal relational operator) 





e¢ 
tt 
i 


ioe <relation> 


N/A 
i] Sx 4 xs 
NZA 
139 + > 
NZA 
140 + <comp> 
N/A 
141 <como> $:= < > 
N/A 
ae ee 
N/A 
143 | ae 
NZA 


mow <while staterent> ::>= <while clause> <do statement> 
zx<while clause>? <do statement>; B8kS 
x{pranch location} 


eet S <waiwreme lause> <°= <while> <boolean exornassion> 
t<boolean exoression>;: ASC foranch address} 


146 <while> °3:= while 
N/A 


147 <for statement> ::= <for clause> <steo exoressioan> 

147 <until clause> <do statement> 
r<for clause>s; <steo exrression>; <unti)l clause>; 
k<do statement>; RRS {oranch aadress} 


148 <for clause> ::= for <assianment statement> 
k<assignment statement>; ARS {branch address}; 
ho GouUnrTer variable), CLIEGAD Yeounter variable} 


149 <steo exoression> : 


>= step <excressian> 
zk<expression>; ADT; SID; 


LITLG@AD {counter variak le} 
= until noneterm> <expression> 


4) <until clause> 3: < 
“Snowe ssiome sca, BSC 


k<until non-term> 
*{pranch aadress} 


e 
e 
e 
e 


Hee] <Uneyl Mon-tCerm> 32> unti } 
ee eet cme); bt, ot Ds ELTLOAD decunter variable} 
N/A if there is a steno exoression) 
152 <do statement> 3::= do <simole statement > 
k<simole statement> 
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164 
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165 
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<eloses statement> ::= close <identifier> 
k{not implemented} 


' <close statement> , <identifier> 
x*{not implementea} 


<suborogram decliaration> ::= <subproaqram nheading> 

<simple statement> 
zk<suborogram headinar>sz <simole statement>; LIT 
{subroutine PRT address}; UNS; RIN; LIT{SBP}: 
ee. 25 De 


“SubOrogGCar T@adina>  sf= <function heading> 
xk<function heagina> 


<orocedure headina> 


i) 
4 
k<procedure neading> 


<function headina> [= <oaramiess function> 


x<paramless function 


Vee 


; stfunction & SCarams> 
<function carams>; SVe 


<procedure heading> : <paramliess proc? 


ke<oaramless proc? 


<oproc & oarams> 
“COC CGe se Oak amsS?, ove 


<paramless function> ::= <declaration tynoe> 
function <jidentifier> ; 
x*<declaration type> 


<function heaa> 
<identifier> ) , 


“TuUMECtIOM & Oatams> °: 
*<function heaa> 


' <function & oarams> 


<declarattion> ; 
A ToMecttonmscarans>, <declaration> 


“TunGeyvomemeaGd> =:= <declaration tvoe> function 
<identifier> ( 

e<ceclaraticn type> 

> “<function head> <iaentifier> , 
kt< function head> 
<paramiess proc> i::= procedure <identifier> ; 
*IMi {carameter count}; Ii {local variable «a 
Cemanewer or rset), ET etbase of PCE}; SAV; BL] 
kif this i§ a nonwtinteger function then 
*LITLOAD {lenath of return value}; 
Dwwieverimadadress of fuUmetion}; LaLN/ALs]} 


eS 





168 
168 


169 
169 


io 


171 


tive 


187.3 


TES 
ey i) 


176 
eso 


era 


79 


180 


feo 


182 


the 5 


€<proc ®% params> !::= <procedure head> <iaentifier> 
) 3 
k<porocedure head>? same as production 16/7 


; <proc & oarams> <declaration> 


| 
k<oroc oarams>; <declaration> 


<procedure head> :3:= procedure <identifier> ( 
otis, 

' <procedure head> <igentifier> , 
N/A 


<procedure call> ::= <call heading> <expressian> ) 
k<call headina>; <exoression>; [Me 

k{address of subroutine in code arear:; PRA 

<call headina> ::= <identifier> 
N/A 


; <call heading> <expression> , 
k<expression> 


<declaration tyoe> external 
function <externa!l list> 


<dec\laratiom> : 


t{not implementeadt 

' external crocedure 
<external jist> 

k{not implemented) 
€external Jlist> :3:= <identifier> 

e{not implemented} 

 ecangternmai | iste, <1 Ggents1fier> 

k{not implemented} 


<case statement> ::= <case heading> <case block> 

k<case headinar>; <case bhlock>; 

kdo n times(n=number of statements in case block) 
BPS {address of case statement (n)} 


<case heading> ::= case <expression> of 
t<exopression;, LIT {(3}3 MPI; [Me 
macgaressmat end of case Hliock}); SER; BFA 


SGasecmerccK>) 2s= Degim <case block body> ; end 
N/A 


<case block hody> ::= <statement> 
xk<€statement>; BRS {address of end of case block} 


; <case block boay> ; <statement> 
kSame as oOroduction 18d 


eS 





ALGOL-M PROGRAM LISTINGS 


% 


100h: /*load point for compiler. 


SR KOK KERR KKK RKB AN KA MR RE RRM RR KK KR KRM MRK KR RK *S 
St RKKRAKAEKEK esvatem Literals 2 SA GRRE Se op ee 9e,8P. 3 */ 
S® SE EE SE ie ee OE ER te hs ak Ee ae is gn eR ES TK SE ATK KR EK ER REE KK KS KK * 7 
declare false literally ‘0°, 
true literaiiv ~ 1°, 
lit literally ‘literally’. 
bios Pit. “oh. “k entry polnt to disk operating svstem */ 


startbdos address initiaifSh)., -Fadir of ptr to top of tdus «*/” 


max based startbdos address, 


boot Lit Oo. /* exit to return to operating system */ 
pstacksize lit °#8°, -"® stack sizes for parser *¥/ 
intrecsize Pit *128°, 
de 1 llt ‘declare’, 
proc lit “procedure’, 
fileeof lit yi tae 
rfile Vit "20°. 
idents ize it “Gee 
addr Pit ‘address, 
forever bit, whi le ctrie’ , 
varesize lit *10@°, 
indexs ize lit ‘address’, 
aiatesize lit ‘address’, 
maxoncount leiotien c.2 ors 
cr leet 3" 
if lit ‘@ah', 
atciungdelim it ~22h', 
questilonmark lit ‘3fh', 
tab iit "99h°, 
eolin lit Poah 
comment lit “ee , 
conbuffsize lit ‘’82°, 
eolchar lilt ‘@dh’., 
hashtblsize hit "64", 
sourcerecaize lit Eels, 
has hmask Lit "63", 
contchar lit ioeh’. 
eoffiller bits lah. 
percent bits 25h 3 
declare maxrno literally "152° ./7%* max read count */ 
ma xino literally °'1i190° ,“® max look count */ 
ma xpno literally ‘'J90’ ,“* max push count */ 
ma xano literaliv ‘'373'°,.-* max state count */ 
starts literally ‘i',/“* start state */ 
prodno literally °'183°,-/"% number of productions */ 
gemic literally °8'° ,.“°*% gemicolon */ 
colonc literally °'13°.7* colon */ 
doc lyterally 18° .7* do *7 
eofec literally "24° ,/“" eof */7 
endc literally ‘26° .“78 end */ 


string literally °49° .“™" string *- 
dec ima | Illterally "52° .7" decimal *7 
integerc ILlterally ‘33° ./*% integer *%” 


proce llterally ‘'54'° ./“* procedure */ 

identifier llt °S53° ,“*identifier*/ 

termnn literally "S5°;:/7™*% terminal count */7 
declare ehloc address iniltlal@é€af*h), 

eeurcebalf based ehlactsourcerecrsize) byte, 

eoenurceptr byte initia l@¢sunureereceaize), 

baffptr byte tit abe ow) 4 

errorcount addresgs initial] >, 

linebnf{fCconbuffslze) hyte, 

lineptr byte inltinIl(¢o?, 


{20 





lineno addrese, 

pass l byte initial’true), 
pass2 byte initial(fatse). 
nointfite byte initlal’ false), 
rfcbaddr address initialf5Sch), 
rfcob based rreboaddr(33) byte. 

. wficb( 23) byte initial(s, *,’ain’ ,90,9,40.9), 
cursourcerecs ize byte initlal€sourcerecsize), 
no look byle, 
production byte, 
arrStloc(35) addsesea. 
arrSnuino byte, 
subSprocS3loc address. 
subSproecS8var8num byte, 
arrsd itn byte. 


diskoutbuff(Cintrecsize) hyte; 


/* the following global variables are used by 


declare token byte, “* type of to 
hashcode byte, ,* has value 
nextchar byte, on 


“* hol 
indicates 


byte, 
ray 3 


accum( idents ize) 
cont byte! 


SRERREMRRE KKK TK RK RK OR EE RR RR RK ROR ERS 


current character 


the scanner al 

Ken Just scanned #¥/ 

of current token x*/ 

from getchar */ 

‘Is current token */7 

accum was full, still more */ 


RE SE OB ER OK OR RE KK RK ZH 


7 symbol table global variables vi 
eer ta eet fee ee et ee Re ok eR Ra eK ERK RARER KEK K/ 
declare base address, ’%*% base of current entry */ 
hashtable(hashtbislze) address, 
sbtbltop address, ‘current top of symbol tablet 
sbtbl address, 
pti based base byte. /’*first byte of entry */7 
aptraddr address, “*utility variable to access table*/ 


addrptr based aptraddr address, 
byteptr based aptraddr byte, 


printnaine address, /*set prior to 
a ymhash byte. 
prev8b1k8level( 12) byte, 

prev8index byte initla1l(€253). 
atep$flag byte, 

bikScnt byte Initial(9), 
bikStevel byte Initial (1); 


deciare read! data(9,39, 
moe. oe? , 49,42, 43.48.53,98,.19,20.26,27. 
Pay. oO. On, Ooo. 15,53. 0082), 2.3.9.280, 28, 


memo d. 0.49, 00,2.3.9.20. 49 ,92.593.55.2. 49 .55,09,2.4979755,2,.2,2.49,55 
11.14.94, 51,55, 19.7, 4.55, 55,2, 13, le,2c. it. 14920 8.11.,7, 1 ¢. 11, 1, 2.8 
arormrg 2+. 33,05, 16.¢.117,2.¢.11,.17,.7,11.7.49.33. 11, 19,29, 27 ,31,34,35 
39 ,.40,42,.43,48,53,55., re ae 14, A 19.20. ree 33,04, 39,09, noe cae 
meee 65,090,500 ,.04%.99,.4511.1,.12.15,21.7.11,7,11,4,11,1,7.12.15,32,7 
°13,36,2.3,9,20, 29,30, 49. ate SG eae ao a Zany OF ao. ae ey 18,11 
mgs. +4. 45,4¢ .50.359.7,13,35.7.11,8.11,41,55.38.50.51,.46.22,37,7,22 
,19,27,31.34,35,39, 40, 42,43.48,55,7.3,5,9,0); 

declare lookl1 data(0@,12,15,9,15.9, :2,9,2,86, iO, 1450.6. 1¢,32.0.2. 14,0.14 
meee, OO, 14.9, 11,.8.11.0,2. t4.17.9,6,10.9,5.19.9,6, 190,9,6, 19.9,6.16,9 
.6,19.9,16,0,16.9,16.9,17,9, P O72); 9.25, 0. 11.0411, 0,33,, +4. 43,47,50 
.54,9,11,9,33.9, 46.9. 33, $4,495.47 ,50,54.90,32,90,22,0,46,0,3.5.9,9); 

declare applyl data(9,4.,1.0,9.,9,.9,0,131. 145.9.9, 149 ,9,0,40,90,244 0,14,15 
meer. oe, 93, 143,090.36. 94:3.0.0,9,27. 15°,9.3.4.32,95.,.9,.9.9,. ‘ eae 
35.36.39. 86.94.95, 112. 122. 120. 134, 134, 137.0, 0.7,.8,10,.,16.57. ~18 
.9,26.9,124.9,3.4¢.3. 14 ok tO, 93-9908 in eo ee 
,63,9.9, VON 6 US eae So ier ao 9,61.7,.0,0,0,0, 14,195,397, 40 
moot], 143,0.0.3.¢9. Ge eee ie eee ae 9.9,9 i 0,.9,9,0,0,9. a 0,0,9 
.9,0,0 0.0.9,0.0.0. 44. Ix, age a. rt, 143.150,0,0.0,52.0 O20 
ie 

declare read2¢254) addrese Initial 


12.15,53,55,2,49,32., 


lookup or enter*/ 


Ve, no, 19, 20,26 ,27,3 1 
31,34,35,39,40,42,43,48,33 
#9 ,52,33,53,553,2,.3,.9.20, 49 





(0,195,331, 392,54. (41,4, 264, 263, 262, 160, 10,353, 358.28 
29, 196, 32,36, 290, 38. 195, 41.336.42,46.53. 159, 28,29, 371,32, 36, 290,38 
(195, 41,336,42,46.53. 159,344,310, 209,358, 333.35,70,289,3,7.16,29,33 
264, 263, 262, 169, 161.3.7, 16,29, 264. 263, 262, 160,312,313,4,7. 16,29, 264 
263, 262, 160, 292, 157, 162, 343, 298, 157, 162.5, 208, 300, 157, 162.20,25,57 
52,69, 229,218, 275,62, 367. 263. 225, 285, 363. 285, 285, 360,357,279, 12,356 
,13,361, 211,355,352, 274.11, 18.191, 288, 287.26. 207. 209,6,311.22, 243 
291,294,217, 158, 163. 269, 28.29.32, 36,290, 38, 195.41,336,42,46,53, 159 
37, 164,281, 14, 28.29, 32,36, 265, 290,38, 195.41, 336,42, 155, 156.214, 46 
,49,53,56. 159, 280, 282, 152. 154,327,370, 295, 302, 362, 364, 284,286, 153 
,261, 154,327,318, 261.24,39,4.7, 16, 29,34. 35,264, 263, 262, 160. 193,359 
,354,293,299,301,31.40, 264. 265, 262, 27.21, 65, 268, 155, 156.214. 49,56 
297,304, 66,296,303. 135,19. 341, 163,278,30.51,.45.38,317,325,39, 28,32 
,36, 290,38, 195,41,396,42, 46, 166,260,8,%. 17,9) : 


declare look2(0 101) address Initial 


CW ene, Jeo. Cee, ola.4¢. 219.47 .90% , 48,261,249, 265 
»240,58,59,.39,265,60,265,.¢1,305 63,203.04, 277 ,67,2906,68, 68, 265, 240 
mee 1. e400, 02, 0a, acol.¢, 6d. cok (4,¢64,24 . 65, 65, 248, 76, 76, 249,80, 252 
Moly 2od.G2,20%,86, 297 .92, 266. 120,319. 121.3920, 12% .366, 128,365,131, 131 
»1391,1391,191, 131,351, 139,238,210, 142, 144, 202, 145, 145, 145, 14°, 145, 145 
pe to. cot 219, 147.333. 149,200. 152, 152, lol. 244) ; 


declare apply2( 177) address initial 


(O,A,77.250. 101, 194, 192.100, 115,116,114. 189,201,203 
Meza 41, $94,216. 219. 198. 3.9. 372, 224, 197,222. 187, 229,219.225 , 226.220 
97, 143,342,345,221.151,151,338, 242. 231,95, 108, 119.314.3135. 283,316 
, 104,339,326, 199.241, 105. 196,245, 107. 349.111, 103,199, 168. 17", 172, 169 
171, 167, 174, 175, 173, 256.235 .83.258. 176. 176,90, 87, 87, 87.87, 8&7. 87,87 
Mie, 69. 6¢,80.87.257. 199.91.177. 272. 279. 185,99.98, 276, 137, 12, 266 
, 134, 237,78, 234, 96,255, 113.1168, 119, 117.396,308, 132. 84.85. 135,.93,93 
.93.93.93,93,93,94, 130, 148, 188, 146, 179, 178, 323, 322,321,324. 26,330 
,233, 126,79, 232, 112. 140, 125, 136.337.334, 183,204, 150,346, 347.348, 186 
, 129,350, 182, 133.239, 239.239 .239, 239, 239. 239.239, 239,259, 122. 205,181 
, 180,296, 123,369, 138) ; 


declare indexl data(9,1,2.50,70,4,.°9,6,6.11.6,6, 12,13, 14,28,6,6.6,42,43 


.43.70,46,70.97,6.238.49.50,50,69,59,60,68.79, 690, 133, 78.79, 135,81, 82 
,85 ,85,86,87,99,91,92,93,94,99,95,96,97,98,99, 190, 103, 105,94, 166,91 
Eeommroe, lit, tig. 103.114.116.117, 11¢,117,117,117, 117,119, 129,50, 122 
» 122, 122, 123, 125, 126,79, 128, 128, 129,131, 132, 134, 135,70, 70,59, 148, 149 
6190, 151, 152.171.1773, 176,177,179, 181,183, 187, 188. 189, 198, 191,201,202 
6203, 209,205 .206 , 207 . 207 . 70, 206, 209 ,212.212,2193,2193,21¢, 78,215,221 
meee, 60,68, 220,220 , 528.229, 230, 105, 233, 215, 234.234, 256, 233 
9206, 249 ,2590,1,.4,6,8.19, 12, 14.18,21.23,25.27,.29,931,.935,938. 41.44,47,56 
,33,53,59¢7,59,61,63,.65,6¢7.69,71,.78, 89, 82.84,91,93,95,9¢7,1,2.4,4%,5,6,7 
meee, 0,3, 86,8, 11, le. 14. 14,.135,15.16,16.16,16. 16.17, 1¢,19.19,.24, 24 
»24,28,28,268,31,32,32,33.33,33.33,33,393.33,933,33,33.39,36,35,41,42 
nao, 00 ,60,60.60,.60,61.61,61,.67.67,79.79, 70, 79,70,72, 72,72, 74.74 
meet, 71, 92, 92,92,95.93.93,95.96,.97.9¢ .98,99,99, 100, 141, 192, 162, 193 
, 193, 104, 104, 105, 196, 186, 196, 107, 197, 197, 108, 108, 1908, 198, 1072, 108,108 
mugs. Oo, 109, 109, biz,112.11¢4.115,.115.116.116,11¢7,118,126, la¢, 127,130 
»130,139, 132,132. 135,136, 136, 136,136, 1397, 137,137, 138, 139,140, 141,142 
143,144, 145, 146, 148, 148, 149,150, 159,151, 151.152, 152, 153. 154, 154, 155 


4 

mio, 156, 15¢.157, 158, 158. 159, 169, 169.179, 178.171, 171,173, 174, 175, 176 
mle 0) 3 

Pmindaex: datat@,1,2,9.8,2.6.5.5.1,3,.5.1.1.14,14.5.5,5.1,2.1.8.1,8 

eerie 2. 9.8, 1,.8,2.8,0. 13.3,8.13.1.35.1,1.1.3.1.1.1.1.1,.1.1.1.1,1 

ee eee eee |. oe. 1.2.2.2. 2.2.2.1,2.9.1.1.1,2.1,.2.8.1,1,2.1 
Seon. oe leit, 1. 19,2.9,1.2,2,.2.4.1.1.1.1,10.1.1,1.1.1.1,.1,.1,.8 

eee ins yO lath. Qe. G, 1. 1,1,1.3.13.1,6,2.1,2,1.11.1.3,3,2.2 
Meee ee eer 2 tat oi)... 0, 2. 2. 2. 2. 2.2. 2.2,.7.2.2,2.7.2.2;.2 
Peele. oc. 2, 0.0, 1,9.1,7.0,1.2.1,.2.9,.2.0,1.%,.9,1,2.2.9.0,9.3, 1 
Mtl. 1. 900.7. 0.0.0°.0,0,60,1,1.1,0.1.0,2.2.3.1.:.0.2.2.9,2.0 
eee Oe Oe. 1 Ot 1,2. 2.1.1.1,2.2.9.2.2.2.1,.2,1.1.1.0.2 
mee eee lee, 1, 1.1.1.2, 1.1.1,.2.1.2,.2.0.2.%.1,.2.0.2 
aoe OO, 8. 1,1.1.1.1.0.3. Meee) 40n <0) 4. 2 FO. 9.9 2 
Were 3 2 2 St 
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Cs giobal procedures */ 
Bae tet Te te acl to ote ees ee Ac rs Wetec ae RR KRENEK KE AKKE EK S 


moni: procedure(f,a); 
declare f byte, 
a address} 
go to bdos: 

end mont; 


mon2: procedure (f,a) byte; 
declare f byte. a address; 
fo to bdos;: 
end mon2; 


mon3: procedure; 
/e*used to return to the system*/ 
goto boot; 

end mon3; 


move: procedure (a,b,1); 
/* moves froma to b for 1! bytes €1 ¢ 255) */ 
deciare (a,b) address, 
(s based a, d based b,1) byte; 
do while (Ll:=1 —- 1) ¢> 2553; 
d=3; b=b + 1; azn + }; 
end; 
end move; 


fill: proc (Ca,char,n): 
/* move char to an tlnes */” 
deciare a addr,(char,n,dest based a) byte: 
do while (n := n ~-1) 6) 255; 
dest = char; 
4 = a + i; 
end; 
end fill; 


read: procedure} 
declare togpmle(3) byte; 
toggle = 1; 
cali monl(19,.toggle): 
end read; 


printchar: procedure(char) ; 
declare char byte; 
cali mon!(2,char); 

end printchar;: 


print: proecedure(a); 
declare a address; 
call moni(9,a); 
end print: 


diskerr! procedure; 
call print(.’de S°); 
goto boot; 

end diskerr; 


openS8sourcefile: procedure; 
call move(.‘alg’.rfehaddr+9.3); 
rfcb(32) = @; 
if mon2(15,rfebaddr) = 255 then 
do; 
call print(€.‘ne 2°): 
co to boot; 
end: 
end openS<ourcefile; 


closeSintSflle: procedure , 


“*% closes a file */Z 
if mon2( 16. .wfeb) = 255 then 


ist 





cali diskerr; 
end cloreSintSfile; 


setupS$intS$file: procedure; 
/* setupSintSfiles a new file */ 


if nointfite then /¥onlv make file if this toggle is off */ 


return; 
call move(.rfcb,.wfeb,9); 
wfieb(32)=98; 
call mnon1l1(19,.wfcb); 
if mon2(22,.wfeb) = 255 then 
call diskerr; 
end setupS8int#file; 


rewitnd8sourceS8file: proc; 
/*tep/’m does not require auy 
action prtor to recpening®¥/ 
return; 
end rewindSaourceBfile; 


readS8sourceSfile: proc byte; 
declare dent byte; 
if(dent:*#mon2(rfite.rfebaddr?) > fileeof then 
call diskerr: 
return dent: 

end readS8saourceSflile; 


writeS8intSfile: procedure; 

if nointfile then 

return: 
call monl(26,.diskoutbuff>?; 
if mon2(2i,.wfeb) (> 86 then 
call diskerr; 

call monl(26,80h); 7* reset dma address <*/ 

end writeSintSfile; 


erlf: procedure; 
cali printchar(cr); 
cail printchar(1f); 
end crif; 


printdec: procedure(value); 
declare vaiue address. i byte. count byte; 
declare deci(4%) address initial( 1006, 1800, 18,1); 
declare flag byte; 
fiag = false; 
count = 3Oh; 
do i = @ to 3; 
do while valine >= deci(i'?: 
valne = value - deeif i); 
flag= true; 
count = count + i; 
end; 
if flag or (€1>= 3) then 
ceall printchar(count); 
else 
eall printchar(' *):; 
end; 
return} 
end printdec; 


printSprod:! proc; 
call print(.' prod = 8°); 
call printSdec(production?;: 
emqil crlf; 

end priutSprod;: 


printStoken: proc: 
call print(." token = $'); 
call printS$dec( token): 
call erlf; 

end print&Stoken: 


(o4 





emit: procfobjcode); 
declare objcode byte; 
if(baffptr:=buffptr+l) >= intrecsize then “*write to disk*/ 


do; 
call writeS@intSfile; 
buf fptr=0; 

end; 


diskoutbuff(buffptr)=obycode; 
end emlt; 


clearS$lineSbuff:procedure; 
call fill€. linebaff,' ‘",conbuffsize) ; 


end clearSlineSbuff; 


listline: procedure( length); 
declare (length,t) byte; 
call printS$dec(lineno);: 
call printS8dec( prev8index+!?; 
call printSchar(" '); 
do i = 9 to length; 
call printchar(linebufft id); 
end; 
eall erlf; 
end listline; 
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St the following variables are used by the parser *S 
Dr OE EE EE ESE EOF KK ROK OK KA KR K KORE KORE RK KK KER KKK K RE KERNS 


declare listprod byte initial(false), 
lowertoupper byte tinitial(trtue), 
listsource byte initial(false)., 
debuglin byte initial(false), 
Llisttoken byte initial(€false), 
errget byte initial(€ false), 
compiling byte, 
codes ize address, 7* used to count size of code area */ 
prtct address itnitial(Offfeh). 7* uged to count size of prt */ 


/* variables used during for loop code generation */ 


forcount byte initial(@), 
randomf ile byte, 
flleio byte initial(€false); 


SRRRRRLLKKMARRERRRRRRA KK AKA PE KR RE RRR RK KK KKK KERR KERR KKK KS 


“* scanner procedures = PA 
SA TRRKRRRR RMT RR RRR RRRRK KR RAKE RRA RRR RRR RR KR KAR RKKRR MK KRKKEK KS 


getchar: procedure byte; 
declare addeof data (‘'eof'’. eolchar,1f)}: /*® add to end if teft off +7 


nextSsourceSchar: procedure byte; 
return sourcebuff(sourceptr);: 
end next8source8char; 


checkfile: procedure byte; 
do forever: 
if (sourceptr:=sourceptr+1l)>=cursourcerecsize then 
do; 
sourceptr=4; 
if readSBsourceSfile=flleeof then 
return true, 
end; 
if(nextchar!=next&saur- ee Behar)<O1lf then 
return false; 
end: 
end checkfile; 


if checkfile or (nextchar <= eoffiller) then 
do; 7* eof reached "7 
call move(.adde>f.sbloc,3): 





sourceptr = 9; 
nextchar=next$sourceSchar; 


end , 
linebuffClineptr:=lineptr + !)=nextchar;: /*outpat line*/ 
If nextchar = eolchar then 

do; 


llmeno = linens +r 1; 
lf tigstsource then 
calli LlisitineClineptr-1); 
lineptr = 9; 
enll cleartinebuff; 
end; 
if mextchar = tab then 
nextchar = ° °'; 
return nextchar: 
end getchar; 


getnoblank: procedure; 
do while((gwetchar = ° ‘°) or (nextchar = eoffiller)); 
end; 
end getnoblank; 


title: procedure; 
call print(.’‘algol-m vers 1.08"); 
call erlf; 

end title; 


printSerror: proc; 
call printdeclerrorcount): 
Gat! printehar(’ *): 
call print(.‘error(s) detected$’); 
eall crilf; 
end printS%error; 


error: procedure(errcode) ; 
declare errcode address. 
i byte; 
errorcount=errorcount+I; 
call print (.’***®$°); 
eall printSdec(lineno) ; 
cali print(.’ error $°); 
call printchar(’ °); 
call printchar(highCerrcod=)):; 
call printchar( low(errcode?)); 
call erlf; 
call printSprod; 
if token-=eofc then 
do; 
call print@error; 
call mond; 
end; 
end error; 


initiallzeS8scanner: procedure; 
declare count byte; 
call open8sourcef tile; 
limeno,lineptr = 9; 
call clearSlineS@buff; 
sourceptr = 128; 
call getnoblank: 
do while nextchar = ‘$°, 
call get8no8blank;: 
lffcount := Cnextchar and Sfh) - ‘'a’) <= 4&4 then 
do case count: 


if pasa! then Llstsource = trne;: 
listprod = true; 

nointfile - true; 

Listtoken = true; 

debugin = true; 


end: /% of enze ks 
call getnoblank; 





end ; 
end initializeSscanner; 
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A scanner x/ 
S RRREKMRRRKMMKKRMKKKKRRKAH KK KKK AKKKARKRREKRKRKAMKKKKRKRKRERK/ 


scanner: procedure; 


putinaccum: procedures 
if not cont then 
do; 
accum(accum := accum + 1) = nextchar; 


hashcode = (haahcode + nextchar) and hashmask: 
if accum = 31 then cont = true; 
end; 


end put inaccum; 


putandget: procedure: 
call putinaccum;: 
call getnoblank; 
end putandget; 


putandchar: procedure; 
call putinaccum; 
nextchar = getchar: 
end putandchar; 


numeric: procedure byte; 
return(nextchar - ‘@°) ¢= 9: 
end numeric} 


lowercase: procedure byte; 
return (nextchar >= 61h) and (nextchar ‘= TVah); 
end lowercase; 


decimalpt:proc byte; 
return nextchar='. 
end decimalpt; 


’ * 
9 


conv@toSupper: proc; 
if lowercase and lowertoupper then 
nextchar=nextchar end Sfhy 
end conv8toS8upper; 


letter: procedure byte; 

call conv8to8upper: 

return ((nextchar - ‘*3°) ¢= 25) or lowercase; 
end letter; 


alphanum: procedure byte; 
return numeric or letter or decimalpt; 
end alphanum; 


spoolnumeric: procedure} 
do while numeric; 
call putandchar;: 
end; 
end spoolnumeric;: 


setupSnextS8call: procedure; 


if mextchar = °' -‘ then 
ceall getnoblank: 
cont = falae; 


end setapSnextS3call: 


lookup: procedure byte; 


declare maxrwing lit ‘9°; 





Heeinre vocap datac@.’ *’,’C(’.°+ ,Sdh,veh. *° .°)'.*3*,'m’, 7 1D’ 


Meee = eee = 4 aw go” 4 [Cclmt | et, Cor’, ’to’,’ eof’, and’ 
,’end’,'’for’,’not’,'pic’.* tab’, 'case’,’else’,’file',’goto’.° read‘ 
.’step’,'’ then’, '’array’. begin’, ’cioge’,’*until’,’while’, ‘write’ 

,’ string’, ’decimal’,’ initial’, ’* integer’ ,’writeon’ 

, comment',’external’,'function'’, procedure’); 


declare vioce data(@,1,16,32,523.81,111, 117, 152, 168, 177); 
declare vnum data(@,1,16,2%,31.38.44,45,50.54) ; 

declare count data(@, 14,7,6,6.,53.0,.4%,1,9); 

deciare ptr address, (field based ptr) (9) byte; 
dectare i byte; 


compare: procedure byte; 
declare i byte: 
i = @; 
do while (field i) = aceum(i := i + 1)) and ? “= accum; 
end} 
return i > accum: 
end compare; 


if accum > maxrwing then 

return false; 
ptr=vloc(Caccum) +. vocab; 
do i=vnum(accum) to (vnumlaccum)+count(accum) ); 

if compare then 

do; 
if 1250 theu 
token=couime nt; 


else 
token=i; 
return true; 
end; 


ptr=ptrtaccum: 
end: 
return falge; 
end lookup: 
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“® scanner main code */ 
Pann ee Re eek KR RR RRR RKKEEKKERKARKERKKEKARMARLREKREKNSELZS/ 


do forever; 
accum, hashcode, token = @; 
do while nextchar=eolchar; 
call getnoblank; 
end; 
ifCnextchar = stringdelim) or cont then 
do; “* found string #/ 
token = string; 
cont ? false; 
do forever; 
do while getchar ‘> stringdelim; 
call put inaccum; 
If cont then return; 
end; 
call getnoblank; 
if nextchar ‘> stringdelim then 
retarn;: 
call putS8inSaccum: 
end; “*® of do forever ¥*/ 
end: /“*% of recognizing a string */ 


else if numeric or decimalpt then 
do: 7% have digit %/ 
token = integerc: 
do while nextchur='A':; 7*elim leading zeros*/ 
nextechar=get. tar: 
end; 
call spoolnumeric: 
if decimnipt then 





do; r 

token=decimal: 

‘call putandchar; 

call spoolnuneric; 

end ; 
if accum=@0 then 

hashcode. accvinfaccum := 
call setupSnextS$rail;: 


return; : 
/* of recognizing numeric constant */ 


1) = °@°; 


end; 


else if letter then 
do; “* have a letter */ 
do while alphanun; 
call putandchar: 


end; 

if not lookup then 

do; 
token = identifier; 
call setupsnextSceall; 
return} 

end} 


else “* is a rw but if comment sakip */ 
if token = comment then 
do; 
do while nextchar <> °;’:; 
nextchar = getchar; 
end; 
call setSnoSb lank; 
end; 


else 


do: 
call setSupSnextScall; 


return; 
end; 
end; “* of recogniziuys rw or ident */ 


else 
do: “* special character ¥*/ 


if nextchar = 25h then 


do; 
nextchar-=getchar: 
do while nextchar ‘> 25h; 
nextchar = geichar; 
end; 
call get8no$8b lank; 
end ; 
else 
doi 
if nextchar = °:'° then 
do; 
call putandchar:; 
if nmextchar = ‘=° then 
call putandget; 
end, 
elae 
if nextchar = ‘"*° then 
do; 


call putandchnr: 

if mextchar = ‘*° then 

call putandget, 
and} 
else call pntandyet: 
if not lookup then 

call errorf ic’): 
call setupSnextS8-eu ll; 


return: 
end; 
end; “* of recognizing spocltal char */ 
end; /“* of do forever * 


end scanner; /* end of seanner 
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“* procedures for synthesizer KS 
SPRUE THKRKEKKERRKRKKKKKK OMG KRR KKK RRR KARE KR 


initializeSsymtbl: proc; 
if passl tlien 
do: 
/* ft1ll hashtable with @'s */ 
call fill( .hashtable,O,eahifhashtblsize,2)); 
sbtbli = .memory:;: 
end: 
/*i initialize polmter to top of symbol table*t/ 
abtbitop = max —- 2; 
end initializeS8symtbl; 


getaddrptr:proc(offset); “*set ptr for addr reference*/ 

declare offset byte: 

aptraddr = bage + ptr + offset: “position for addr reference*/ 
end setaddrptr; 


setSblk@level:proc( level); 
declare level byte; 
call setaddrptr(6) ; 
byteptr = level; 

end setSbik$level; 


grethash:proc byte; 
declare hash byte, 
i byte; 
hash = @O 
aptraddr = base + 2; 
do i = 1 to ptr; 
hash = (hash + byteptr(i)) and hashmask; 
end; 
return hash; 
end gethash; 


nextentry:proc; 
base = base + ptr + 8B; 
end nextentry} 


gsetiink‘: proc; 
aptraddr = base + 1; 
end setlink: 


hashtblSof@symhash: proc address; 
return hashtable(symhash) : 
end hashtb18o0f8s ymhash; 


limits: proc(count)} 
/¥check to see if additional sbtbl wil! overflow limits of 
memory. if so then punt ¢lse return ¥/ 


declare count byte: /*size being added is coant */ 
if abtbitop <= (sbtbl + coant) then 
do: 


call error(’to'); 
call mond 
end; 
end limits:;; 


setaddr:proc( loc); 
/*ret the addreas field and resolved bit’ 
declare loc address; 
call setaddrptr (4); 
addrptr = loc: 
end getaddr; 


lookupS8currentSblik: proc(chkSbtk> byte; 
declare chkSbIik byte, 
len byte. 
n based printname byte: 





- basethashtb!18o0f$s ymhash! 
do while base <> 9; 
call setaddrptr(6): 
if byteptr < chkSbIK then 
return false; 
' if byteptr = chkKk&SbIkK then 
do 
lf (Cleni=zptr) = n then 
do white (ptr(len + 2) = nf len??; 
if (len := len - 1) = © then 
return true: 
end; 
end; 
call sgetlink: 
base = addrptr; 
end; 
return false; 
end lookup$currentS$blik; 


lookup: proc byte: 
declare teast3blik byte, 
teatSindex byte; 
testSindex = prevSindextl: 
testS8blk = bikSlevel; 
do while (testSindex ‘= testBindex - 1) “> 255; 
if tookupfcurrentSblk( testSb1lk) then 
return true; 
testSblk = prev8btikSleveil restSindex) ; 
end; 
return false; 
end lookup; 


enter: proc, 

‘*eanter token reference by printname and symhash 
Into next avallable location in the symbol table. 
get base to beginning of this entry and increment 
sbtbl. also check for symbol table full. *S 

deciasre 1 byte, 

n based printname byte; 

call Limits(1:=n+8); 

base > abtbli;: /“*base for new entry */ 

call move(printname + I,sbtbl + 3,€ptr ‘= n)); 

call setaddrptr(3);/X*set resalve bit to @*/ 

byteptr = 6; 

call setilnk: 

addrptr = hashtbi8o0f8symhaselr; 

hashtable(symhash) = base; 

call setSblkSlevel(bIikSlevel): 

sbtbl = abtbil + 1; 

end enter; 


metlentproc byte; /*return length of the p/n */ 
return ptr; 
end getien; 


getype:proc byte: /freturnsa type of variabler/’ 
call setaddrptr (3); 
return byteptr; 

end getype: 


setsubtype:proc(stype);/*enter the subtype in sbtbl*/ 
declare atype byte; 
call setaddrptr(7); 

byteptr=stype: 

end setsubtype; 


wetSparm: proc byte; 
call setaddrptr( 10); 
returo byteptr; 

end getparm: 


metanbtype: proc byte:/*retirvn the eubtype*/ 
call setnddrptrf 7); 





return byteptr; 
end getsubtype; 


setype:proe (type); “*set typefield = typex/ 


.declare type byte; 
call setaddrptr (3), 
byteptr = type: 

end setype:. 


gwetaddr:proc address; 
call setaddrptr( 4) ; 
return addrptr; 

end getaddr; 


do; /* block for parser */ 


/* pneumonics for ALGOL-M machine */ 


etr 
dcb 
als 


declare nop lit ‘°@’ 
lod lit “4! 

ald lit ‘8’ 

adi lit ° 12’ 

mpi lit °16° 

dneg lit ‘21° 


nipd 
neg 


a » 2S <= e dl 


Pat , 
lit . 
helet : 
add lit ‘193’, sbi lit 
Lit : 
Pict : 
Lit : 


ints ltt 
dmp lit 
aid lit 


rey 
a Gy 


ue 8 a 


dvi lit 
cil lit 


plc 


woo 


deci lit "25". pep (20. imi lit 
Cate it 

brs lit °34’, bse lit °35°, Iss lit 

glea lit °38', @tr lit “O9°, detr lit 
eql lit °42°, deql] lit ‘43°, seql lit 

dneq lit °%6°, sneq lit ‘4¢°, gweq lit 
sweq lit ‘'30°." leq lit ‘SI', dleq lit 
inot lit ‘S44’, dnot iit ‘535', snot lit 
dand lit ‘58°. sand lit ‘59°, ior iit 
Soret °GO2..ewie Lit “63° , wde iit 

wid lit °66°, wad. Lit "6s 4 wad lit 

bra tit ‘70’, row lit ‘TI’, sub lit 

red lit <4” , res lit ‘T3'", rdi lit 

rde lit ‘78’, ren lit ‘V9', ecr lit 

‘wdi Lit '82’, aoaa@i lit '83’, slid lit 
gsd 1:¢ '86’', opn iit ‘87°, els lit 

rdf lit °'9@’, edr lit ‘91°, edw lit 

grav lit ‘94’, awv2 lit °95°, uns lit 


declare state 


statesize, 


statestack(pstacksize) statesize, 


hash( ps tacks ize) 
symloc(pstacks ize) 
esrloc(pstacks ize) 
var(ps tacks ize) 
type(pstacks ize) 
atype(patacks ize) 
vare(varcs |lze) 

var index 
(sp,.mp.mppl,nolook) 
ons tack( maxoncount) 
ciabing 

ctlab2 

c lable 

strS8s ize 

dec83s ize 

n 

pynum 

saveparm 

parme haeed saveparm 
fpcount 

parmbage 

procS$type 
(ptest, 1) 

peount 

type temp 

fflag 

lpeount 

sident 


byte, 
address, 
address, 
byte, 
byte, 
hyte, 
byte ’ 
hyte, 
byte, 
byte, 
byfe initial(2), 
byte initial(23), 
byte, 
Lyte initial(€19), 
byte initial(9), 
brte, 
byte initiali(l@?’, 
address, 
ba-(e, 
byte, 
peddrese, 
bs tay. 
bvte, 
ivte initial @> , 
ryte, 
Satrtves, 5 
byte, 
address; 
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initialize8synthesize: procedure; 
codealze,onstack.clable = 0: 
prevStndex = 255; 
bikSent = @; 
bikSleve 1=90; 


end LinitlalizeSsynthes ize; 


syntheslze: proc} 


/*® RRKK a@yntheslze local declarations *X<**T */ 


declare simvar lit "Obb 
subvar Pit ~99°., 
pro lit vo 1 aan 
extSproc fit ~83° . 
bit8in$func lit) Ca. 
const lit ‘06°, 
lab Pit “OC". 
integer Fit. = 6G. 
str List ok 
filel bit ssG@en .. 
func lit ‘QOdh’, 
parm tit 10h : 
declare (typesp.typemp, typemp!1) byte, 
(hb, temp) byte. 
(stypesp,stypemp,stypemp]1) byte. 
(hashsp, hashmp,. hashmp!]) byte. 
(symlocsp,symlocmp, symlocmp!) address, 
(sriocsp,srlocmp) address; 
7 TESS SESS ST SLES SLES S SS EDS ELS SS SLE SES OSSSH SSeS eSSSPesSesie Ss 3 */ 
Ee KEKKRARKKRKE code generation proc’s ee ket ee 7 
Zt BaP oRe hee chee Pe iC ee ee Sie oe ote ICR SL ONE SR cee SRS OR CSI OE SEE CIC SC KCK SOE SEE EE SEK EEE EE I sie ok 7, 


copy: procedure; 
typesp = type(sp); 
typemp! = type(mppl): 
typemp = type(mp) ; 
stypesp = stypelep): 
atypemp! = stype(mpp!); 
stypemp = stype(mp) ; 
aymlocsp = symiloc(ep); 
symlocmp! = symloc(mppl1):; 
symlocmp = symiloc(mp): 
hashmp = hash(mp);: 
hashmp! = hash(mppl1):; 
hashsp = hash(sp); 


grlocsp = srloc(sp); 
srlocmp = srloc(mp): 
end copy; 


setsyvmiocsp: procedure(a); 
declare a address; 
aymioc(sp) = a; 

end setsymlocap;: 


setaymlocmp: procedure(a): 
declare a address: 
symloc(mp) = ay 

end sets ymliocmp: 


gettypesp: procredure(hb?): 
declare b hyte; 
type(sp) = b; 

end settypesp; 


tages 





setstypesp: procedure(/b): 
declare b byte; 


stype(sp) = b; 
end setstypesp; 


setgtypemp: procedurelb): 
declare b byte; 


stype(mp) = b; 
end setatypemp; 


gettvpemp: procedurelhb); 
declare b byte; 
type(mp) = b; 

end settypemp; 


sethashmp: procedure(hb); 
declare b byte; 
hash(mp) = b; 

end sethashmp; 


sethashsp: procedure(lb): 
declare b byte; 
hash(sp) = b; 

end sethashsp; 


gaetsriocsp: procedure(a); 
declare a address; 
sriocfsp) = a; 
end setsriocsp; 
setsrlocmp: proc(la); 
declare a byte: 
srioc(mp) =a; 
end setsriocmp:; 


gwetsriloc: proc byte; 
call setaddrptr(8); 
return addrptr} 

end getsrloc; 


generate: proc(objcode) ; 
/twritea generated code and counts size 
of eode area. */ 
declare objcode byte: 
codesilze = codesize + 1; 
if not passl then 
call emitCobjcode); 
end generate; 


genSintS@v: procla)d); 
declare a byte; 
call gwenerateCimi): 
call generatela); 
end gendintBv; 


IncrSbdikSlevel: proc; 
prev®bik&level(prev@index := prev8index+!l) = bikSlevel: 
bikSfevel = bIkScnt + 1]; 
bikSent = bIkScntt+l: 
call generate(bli); 

end incr®51k$Slevel; 


decr@bik8level: proc; 
bikSleve) = prevBbikSleve lt prevBindex);: 
prevSindex = prev8Bindex<- i: 
call generate(blid); 

end decrSbik@level; 


caleSvarc: procedure b) addrocs,; 
deciare b byte; 
Pemurnavar’b) + .varc: 

end calcS8varc; 





setlookup: procedure(la) ; 
declare a byte: 
printuame = calceS8varc(a?: 
symhazh 2? hhash€a); 

end setlockup: 


lookipSonly: proceduare(a’ byte; 
declare a vpyte; 
call setlooknuplad;: 
if lookup#currentS$bikt blk#ievel) then 
return true; 
haseSflagw = true; 
return false; 
end lookup8only: 


fullSlookup: proec(a) byte; 
declare a byte: 
call setlookup(a) ; 
if lookup then 
return true; 
return false; 
end fullSlookup: 


normm lSlockup: procedure(a) byte: 
declares a 4yte; 
if lo»>»kupfounlyla) then 
return true; 
eall enter: 
return false; 
end norma l8lookup; 


countprt: proc address; 

“*eounts the aize of the prt *4 
return ‘prtct := prtet + 2): 

end countprt: 


gentwo:proc(a) ; 

/* writes two bytes of object code on disk far 
declare a address; 
call generate(high(a)>?; 
call gwenerate( lowla)), 

end wentwo; 


literal: proc(a): 

declare a address; 

call grentwola or 8006h) ; 
end ilteral, 


setcname:proc; 
printname:.clabling: 
3ymhash-clable and hashmsk;: 
end setcname; 


enter8compilerStabel:proctb): 
decliare b byte} 
if pasel then 
do: 
call setcname; 
call enter: 
call eotaddrlcodesize + hb); 
end; 
end enterS8compilerSiahbel: 


sgetS8compiler$inabel: proc: 
declare x byte; 
*labie = clable + 1; 
call satenome; 
if pase2 then 
x= lookup; 
end setScompilerSlabel: 


compllerSlabe sl: proc; 


Pao 
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call setSconmpilerSlabel; 
call cen8twolgetaddr?: 
end compilerSlabel; 


aetSenter: proc(la)} 


declare (a,b) byte: 

b=elnble;: 

clable=a; 

call enterS$compitlerSlabel!Q); 
clable=b; 


end setSenter; 


branch8c lanse: proc(a); 
declare a byte}; 
call generatela);: 
call compilerS$tabel; 
call settypemp(clable): 
end branchSc lause; 


procfa): 
byte: 


process8caseSlahel: 
dectare (a,b,x) 
b=clable; 
elableta; 
call g@eneratel(bra) ; 
call setcname: 
if pase2 then 

x= lookup: 

call genStwol(getaddr): 
clable=b; 

end process8caseS8tlabel; 


case8state: proc; 
call process$caseSlabell(type(mp-2)); 
n=nt+1; 
clable=clabletl; 
call enterScompilerS8label('’; 
end case8<tate; 


litload: proc(la); 

dectare a address; 

call gentwola or 0c9O0h) ; 
end lLitload; 


step8gzen: 
call 
call 


proc; 
menerate(adi)s: . 
generate(sld); 
call enter8compllerSlabe!i0); 
call titload(sident); 
end etep8gqen: 


chktypl: proc(a): /“* check mp.sp to see if they are both decimal ¥*/ 
declare a byte; /* both integer, one of each, or niether *2 
if (stypemp-=Int) and (styperzpzint) then 
call generate(a); 
else 
if (stypemp=dec) and ‘sttpesp=dec) then 
call generate(a+l): -* generate decimal operator “/ 
else 
if €stypemp-dec) and ‘aitypesptint) then 
do; 
call generatefcll): “*® convert integer to decina!l */7 


call generate(nr-!); 
end; 
else 
if (stypemp=int> 
do; 
call genera: 
call penerateta=1); 
call setetypemp! dec); 
end; 
else 


if typemp<> fue 


ee aes 


or pasel 


vette 


and €atypespzdec) 


then 


then 





call error('mt’); 
end chktyp!; 


chktyp2: proc byte; 
if stypesp “> stypermp then 
do; 
call error('’mm');: 
return false; 
end; 
return true; 
end chktyp2: 


chktyp3‘ proc byte; 
call setstypemp(stypesp): 
if Catypesp-=int) or tsatypesp=dec) then 
return true; 
call error (‘’mf'); 
return false; 
end chktyp3; 


chktyp3: proc byte; 
if (stypemp‘>str) or fstypnesps>str) then 
return false; 
else 
refurn true; 
end chktyp3: 


chktyp6: proc; 
if pass2 then 

do; 

if (stypemp=Int) and fetypesp=dec) then 
call error(’id'); 

if (typemp<>simvar) and (typemp<s>subvar) and (typemp<*fital) then 
do} 

lf (typemps> func) or fnot fflag) then 
call error(’as'): 
end; 
Tae, Cuds 
, ¢ ead) Ghrtyp6e 55.00 


gencon: procfsubtype) ; 
declare (i,subtype) byte; 
genSaccum: proc: 
if pass2 then 
do ii to accum;: 
call emitCaccum(i)): 
end; 
end genSaccum; 
call generate(subtype); 
call gettypemp(conet);: 
cali setstypemp(subtype'!: 
if subtype-int then 
do; 
if accum§ then 
call error(’ lo’): 
call genS8accum} 
if pass2 then 
call emit(@) ; 
codes ize=codeas lze+2:; 
end: 
else 
do forever; 
if subtype-str then 
do i = 1 to acecum: 
call gwenerate‘¢acecum(1)):; 
end: 
else 
do; 
call gen$accum: 
codeaize=codeslze+!accumt+!) 72; 
end; 
if cont then 
call seanner,; 


(3 





else 
do}; 
if subtype-dee then 
eall gentwo(Q),; 


else 
codeasize = codestze + 2; 
call wenerate(9);: 
return: 

end: 


end: 
end gencon; 


processS8store: proc(a); 
declare a byte; 
lf chktypS then 
call generate(at2) ; 
else 
call chktypli(a):; 
end processSstore; 


menSloc: proc(a.b): 
declare a byte, 
b address; 
if a =iInt then 
call literal(b): 
else 
call litload(b); 
end gen8loc: 


get@field: proc: 
genSread: proc(a); 
declare a byte; 
If stypempl=Int then 
do; 
call generate(a); 
call gwenerate(sid!; 


end; 
elge 
if atypempl=dec then 
do; 
call generatefr+1); 
call gwenerate(sdd); 
end; 
else 
do; 


call generate(a+2) ; 
call generate(f-asd); 
end; 
end gen8read:; 


call gen8Bloc(stypemp!.symlocmpl);: 
if fileio then 
call gen8read( rd!) ; 
else 
call gen8read(rci);: 
end getS$field; 


putSfield: proela);: 
declare a byte; 
If fileio then 
a=at+3; 
if atypempl=tint then 
do; 
if typempl=subvar tlicen 
call generate! lod?: 
call generate(a?; 
end; 
else 
if stypempltdec then 
call geonerate(a+t): 
else 
call gwenerate(at2): 
end putSfield; 





‘ processSproc: prec(a): ; 
declare a byte; 
call settypemp(a) ; 
if pays2 then 
do; 
call setsarloemp(srlocmp:-getsrloc): 
call setstypemp(getsubtype) ; 
parmbase=basetptrt+J1; 
end; 
end process$8proer;: 


processS$ident:proc(a) byte; 
declare a byte; 
if fullSlookup(a) then 
return getype; 


else 
if pass2 then 
do; 
call error(‘ud’): 
return false; 
end; 
else 


return func; 
end processSident:; 


processS8array: proc(a); 
declare (a.b) byte; 
if ((b:sprocesas8ldent(a))} “- subvar) and pass2 then 
do; 
lf b<>® then 
call error(' In’); 
end: 
else 
do; 
call setstypemp(getanhtype); 
call setsymlocmp(symle-inp:*getaddr): 
call settypemp(subvar) ; 
end; 
end process$8array: 


processSidentSdcl:proc(a.b.c); 

dcl(a.b.c) byte; 

pynum= pynum?+ 13 

if not normalSlookup(a) then 

do; 

call setype(b); 
call setaddr(countprt):; 
call getsubtype(c);: 


end; 
else 
if paesl then 
do; 
if wetype=parm then 
do; 
call setype(b); 
call swetsubtype(c’: 
ptest=ptest-l: 
end: 
else 
call error(‘dd'); 
and: 


end procesca8identS$dcl;: 


proc$sav: proc: 

call genSintSv( peount); 

call genfint8v( ( pyvnumt3) £2? ; 
call tliteral€symlocmp); 

cal! generate(sav),; 

call gwenerate(bli); 

lf procStype=fune then 

Aes 
if atypemps> int then 


en. 





eall lit load(symiocmp?4) ; 
eall literal (€symilocmp);: 
if stypemp=dec then 
eall generate’ald); 
else 
eceall generatetatls?); 
end; 
end: 
end procsav; 


check$parm: proc(la)s 
deciare a byte, 
t address; 
if pazs2 then 
do: 
b=base; 
base=parmbase;: 
if a *‘* getsubftype theu 
call error’ ‘pm');: 
parmbnse=baset+ptrt+s; 
base th: 
end; 
cail generatel imi): 
call weneratelad): 
end checkparm; 


proc$Spro: proc: 
call wenerate( Im2) ; 
call genStwo(srtocmp);: 
call generate(pro): 
end proc$pro: 


process$procS8icl: procla.b.c}: 
declare (a,b,c) byte; 
call procesaSident8della.b.c?; 
pynum,. peount=0; 
cali setsymlocmp(symlocmp:=cetaddr) ; 
if pass! then 
prtct*prtct+4;: 
if (proc$type:=b) = func then 
do}; 
call titeral(symloemp+4) : 
call generate(xch); 
call generate(sid); 
end; 
call branchS8c lause(brs): 
if passl then 
do; 
call setaddrptr(8): 
addirptr=codesize; 
sbtbl=sbtbI+3; 
gaveparnitsbtbI-1; 
end ; 
- eall inerSb{k8level; 
end process8proeS8de i; 


process$8var: proc(a); 
deciare (a,b) byte; 
if (b:=procegaS8ident(a)) = eimvar then 
do; 
call aetsaymiocsplsymlocep:tgetaddr): 
call settypesp(simvar'!; 
call setatypesplertanhbtiype): 
end; 
elmae 
if b=func then 
call procesarfproe( tune; 
else 
if b.> O then 
call error’ ip’): 
end process$var:; 
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process$8s ilmvar8dcl: proc(a,h); 
declare (a,b) byte: 
eall process$identSdcl{a.aimvar,stypemp) ; 
if stypemp<> int then 
do; 
call literal(getaddr): 
if stypemp*dec then 
call generate(b): 
elge 
call- generate(bt1); 
end; 
end process$simvar8dcl; 
proceass$8label: proc; 
if passi then 
do; 
if fullSlookS$up(mp) then 
call error(‘dd’):; 
else 
do}; 
call enter; 
call setaddrfcod+sizse); 
call setype(iab): 
call setSblkSlevel](bIkSlevel); 
end ; 
end; 
end procesas$label: 


resolve8label: proc; 
declare (chkSbIk.tindex) byte: 
if pass2 then 
do; 
if (Cnot fullSlookup(sp)) or (retype “> lab)) 
call error(’ul’?; 
call setaddrptr(6); 
chkS$blik=byteptr; 
tindex=prev8lindex; 
if bi kSlevel<>chKSbIk then 
do; 
do while prev8b1kSlevel(tindex) > chkSbIk: 
tindex-=tindex-1; 
end; 
call gwenerate(dchb):; 
call generate! prevSindext+Ii-t Index); 
end; 
else 
call genStwo(nop) ; 
end; 
else 
call gen@®twolnop): 
call gwensrate(bra); 
call grenStwolgetaddr); 
end resolveS8label;: 


processSarray8dcl: procfa): 
declare a byte; 
call processBidentSdcl(n.subvar,g3typemp) ; 
arrSloc(arr$num) =wetaddr;: 
arrSnum-arrS3num 1; 

end process8array$dcl: 


closeSfile: procfa); 
declare a byte; 
if processSidentla) then: “* not Implemented */ 
else call error(’uf’):; 

end closeBfile; 


ass ignSstmt: proc; 
call chktyp6; 
if Clpcount:2lpeount-1)4-70 then 4* tests multiple 
call processS8$atore(ailt?;: 
elae 


14] 


then 


azgsizn stmts */7 





call process$store(sid): 


end assipnS8etmt;: 


/® execution of synthesize hegins here---- 


if Listprod then 
call printSprod; 
call copy: 


KS 


do case production; “’* call to systheslze handles one prod */ 


/*ease 8 not used */ : 
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i “program ::2 ¢bisck* ~!2 


if pass! then 
do: 

passl = false; 

lf errorcount > @ then 

do; 
call printSerror; 
call mon3; 

end; 

call rewind$sourceSfile; 


call gentwolcodesize+i); “*® plus one to include 
call gentwo(countprt): 
end; 
else 
do; 
call printS8error;: 
call generate(xit): 
call generate(?’fh);: 
call writeBintSfile: 
call closeBintSfiie: 
call mond: 
end; 
Pi block) ::2= <bloek head> <block end> 
3 <block head> ::= ‘block head> “<declaratiom 3; 
4 { <begind> 
; 
5 <bewim> ::: begin 
call inerSb1k8level; 
6 Cblock end> ::= <block body ; end 
call decr8b1k3level; 
re’ {block body> ::: ‘“atatement> 
3 
8 | <block body> 3; <statement? 
9 Cdeclaration> ::2= <file declaration 
3 
i9 f <siinple declaration? 
3 
1i | <simple declaration> 
li ‘initial option 
ie | “array declaratiom 
i3 | <array deciarnation» Cinitial 
; 
14 | <“subprogram declaration 
iS | <Cexternal deciaration>? 
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28 


29 
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39 


<simple declaration» ::2: “declaration head 
Cidentifies > 


call processSeimvarSdcellsp.aild); 


<initial option> ::5 


<initial head> ::5 


CInitlal 


head> Ceonstant>? ) 


inltial ¢ 
t 
1 <inttial head> “constant , 
<declaration head’? ‘+:= Cdeclaration type> 


$ 


| <€declaration head? ‘ident lfier> 


call process83IilmvarSdcl(mppl.,aid?: 


declaration type> ‘:: = string 
do} 
eall setstypesp(l(str): 
call gen8lntSv(sitr@slze); 
end; 
| etringe “size option? 
do; 
eceall setstypemp'! str); 
end; 
| integer 
call setstypesp(int); 
| declmal 
do; 
call setstypespl(dec); 
call genSintSvidecSsize); 
end; 
| decimal ‘size optiom 
call setstypemp(dec); 
<size optiom> ::5 ¢ “vartable>? ) 
if stypempl=int then 
eall Ltitload(symloecmp!); 
else 
call error(’si'); 
i € <tntegwer>? } 
do; 
eall move(calcSvarc(mppl),.accum,7): 
call gencon( Int); 
end; 
<statement> ::= ‘balanced statement? 
| <anbalanced statement? 
“balanced statement> ::= (simple statement> 
| <if clause? <true part> else 
<balanced statement> 


call set8enter(typemp!): 


| <label defintition>? 
Cbalanced statement> 


% 


<unbalanced statement? 
cali setSenter(typemp): 


_- 
cm 


call setSenter(typenmpl): 
| 


‘ 
<true part*> ::s 
do; 
eall branch&8c lanusefbra); 
call 
end; 
“ label 
ent l 


definition? ::= 
processS iyi]: 


Cif claunse> <statement-> 


‘lf clause> “true part?” 
alse “Cunbalanced state: nt? 


“label definition? 
Cunbalanced atatement®: 


‘haloneed stontenent> 


setBentor( tynelan- it) ds: 


CAitent 1. tear: 


1 €interer 


ceall processflabe!l; 
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49 “simple statement> ‘::2 “block? 
+ 
dt | <assigrment statement? 
42 1 <for statement? 
43 | <while statement> 
44 | <read statement? 
435 | “write statement> 
46 | <case statement> 
ac | <go to statement? 
48 | “elose statement? 
- 
49 | “procedure cail> 
call generate(lpop):; 
390 | <identifier> 
do; 
if (Cprocessfident(sp) <> pro) and pass2) then 
ealit error® nt ); 

call process$proc(pro); 

call procS$pro: 

call gwenerateCpop); 

end; 

31 Cassigenment statement” ::23 <left part? expression 


call assignS8stmt; 


Cleft part- 


“assignment 


call assign8stmt; 


statement> 


rs 34 Cleft part» <variable? := 
do; 
if typemp<>subvar then 
call genSloc(styvpemp,symlocrp) ; 
Ipcount-ipcount+!: 
end; 
54 <expression’ ::. “arithmetic expression> 
; 
5S | if expression’ <expression> 
56 ‘arithmetic expression> ::5 < term 
; 
oe | <arithmetic expression 
3@ 4 frm 
call chktyplladi): 
58 | <arithimnetic expression 
58 et tn. 
call chktypi(€sbi); 
39 | <arithmetic expressicr 
39 terre. 
if chktypS then 
call gwenerate(lcat); 
60 f =- < tern 
if chktyp3 then 
call generate(ner!: 
6 1 | + < term 
if chktyp3 then ; 7* no action reaqnired *7 
62 Cterm j$$:2 Cpriimnry? 
63 [| <term * “primary? 
call chktypl(mpi): 


6-4 1 < terupd 

cull chktypi(dvi?: 

63 primary? :$:= “primary 

66 | 

call ehktypifixp:: 

6¢ primary element. <c:= < 

lf: typesp=simvar thea 

call 


ited 


Sore his 


‘primary> 


elenent: 
*¥* “nrimary element? 


variah!>: 


litload(Ceymlocesap) ; 
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elge 
if typesp<> subwar then 
eall proc$pro: 


68 | <constant> 
3 

69 | <procedure cal I> 

79 | € Sassignment statement> ) 
caii setstypemp(atypemp:=stypemp!); 

al | ( “expression? ) 
do; 


call setstypemp(stypemp!); 
call settypemp(typempi): 


end; 
Pee “conatani> ::= Cinteger? 
call gencon(int)s 
73 | “dew ima I> 
call gwencon(dec); 
T4 | <string> 
call gencon(str): 
73 (variable? ::= Cidentifier> 
call process$var(sp); 
76 i! €snbscripted variable> 


ae 


rere ‘file deciaration”» ::= ‘¢fite head> ‘file name> 


C8 «file head> '::= file 
$ 


79 | “file head> <file name> 
3 
8A €flie name> ::= ‘<string> “length option 
81 | <string> 
82 | <identifier> <length optiom 
call proceasBident$dcl€mp,filel.9); 
83 | tidentifier> 
call process8identSdcl€sp,filei,9); 
84 <ien@th optiom ::= ° Cidentifier>? & 
if process8identi{mp)=int then; 
83 } ° Cinteger> 8 
call gwencon( int); 
86 <array declaration ‘:= Carray lList> “bound pair tist> 
do; 


call genS8int8v( arrSd im) 
call gen8intSv(€arr$Snum) 
call gwen8intSv(stypemp) 
cali generate(row); 
do white (CarrSnum := arrSnum-1)¢>255; 
eall literallarrStioc(CarrSnum) >; 
end; 
end; 
87 Carray list> ::= Carray head> <identifier> 
call process8arraySdc l(sp) ; 
88 <array head> ::= ‘dectaration type» array 
arrSnum=@; 
89 | <array head» ‘identifier? , 
cali process8array8icl(mppl); 
90 <bound pair list> ::= “bound pair head> <bound pair> 8 
arr€dim-arrSdim+i: 
91 <bound pair head> ::= ' 
arrsd im=868; 
92 | <bound pair head> <bound pair> , 
arr$dim-arr$d imi; 
93 “bound pair> ::5= <expressiom : Cexpressiom 
if (atypemps’> int) or (stypesp< > jnt) then 
cali error( bp’); 


oo £20 ee 


94 Csubacripted varinbdle> ‘::= ¢subscript head> 
9-4 Cexpresaiom 2&2 
do; 
if stypempl’> int then 
call errort sh’); 


call tittoad(symnlocmp) ; 
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eall gwenerate(subo?: 
end: 


95 <subseript head? °=3 Cidentifier>? °* 

call processS8arrayv! mpJ: 
96 | <subscript head> ‘expressicn 

if stypempl ‘> int then 
call errort’sh'); 

97 “go to statement’> :.= <go to Pdentifier> 

call resolve€labe !: 
93 | <go tad> Sintewer>d 


call resolve#®label;: 
99 ‘go to> :: 2 go t» 


199 | gato 


1901 Cread atatement: ::= ‘read head> ‘variable? ) 
do; 


call getS$field; 
lif filelio then 


do; 
flleio=faigve; 
end; 
else 
call generatelecr!; 
end; 


102 <read head> ::= rend ( 
call generate(ren)? ; 


@ 


193 | rend <file optlom ( 
104 | “read head» Cvariable> , 
call getSfleld; 
105 Cwrite statement? ::= “write head> ‘expression’ 3} 
eall pntSfleld(€wic); 
106 | Cwrite head> ‘tab expression 
107 1 write head> Cpic definitien 
108 <write head> ::= write ( 
call generate(dmp): 
109 | write <file optiom §( 
110 | writeon ( 
$ : 
Pei) | writeon (file optiom ( 
ile | “weite head> <‘expressiom , 
call put8field(wic?,; 
113 ' write head> ‘tab expression , 
H 
114 | <spite head> “pic definition . 
; 
113 Cflie option> ::= <identifier> 
if proceass8ident(sv' = filel then; 
116 f <tdentiflier> ‘Cree optiom 
if processS8identimp’ = filel then; 
aise call error! inf’); 
bic | <string> 
; 
116 | <string> <rec option> 
119 Cree optiom ::: . ¢ideutifier> 
if (CprocessSident(sn) = simvar)? snd (gwetsnbtype = int)) 
elee call error (‘ni’); 
I29 1 . <integer> 
eall gwencon( int): 
121 “pic definition = “pie head* “pie list? ) 
2s Cpic head> <?:2 pie <etring 
; 
123 eine tontift ier 
aos tf 


if Cprocess$tident! <n) = simvar and getsubtype 
elae call errort ‘sc ': 
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124 <pic fist) ::2 € “expreseion 
125 ISpic- list? . Sexpressian>? 


126 <tab expression> ::+ tab Sexpression> 


12 <if clause» ::= if ‘boolean expressivun>? then 
call branch8clause(ber', 
12% Cif expression> ::= vif elause> ‘expressiom else 


129 <boolean expression> ::2= <boolean term 


° 
% 


139, | <hooltean expression or 
130 boolean term 
call chktypl(bor); 
131 <boolean term ::: <hoolean primary? 
132 ! not <hoolean primary? 


if chktyp3 then 
call generate(noto?: 


133 1 “boolean term and 

i33 “boolean primary? 
call chktypl(ando):; 

13+ <hboolean primary> ::= ‘logical expression 

133 | € <boolean expression ) 
call setstypemp(stypempi): 

136 logical expressiom ‘::= Cexpressiow ‘Crelatiom 

136 <expressior 


if (stypemp=str’} and (stypesp=str) then 
call generate(typempi+2); 


eisge 
call chktypli(typemp!): 

i137 Crelatlon> ::= = 
call settypespleqdl); 
138 ies 

call settypesp( iss); 
139 } > 
cail settypesp(gtr); 
146 1 <comp> 


a 
141 <comp> 3:2 ¢ > 
call settypemp( neq): 


142 | < 
call settypemp( leq); 
143 = = 
call settypemp(cey); : 
144 Cwhile statement> ::= ¢(while clause> <do statement> 
do; - 


call generate(hbrs); 
call genStwolsymlocmp); 
call set8enter(typemp) : 
end: 
145 <while clause) ::= <while> “<“boclean expresslon 
call branchS$c lause(hbec?;: 
146 <while> ::= while 
call setsymlocmp(codesize) ; 
147 ‘for statement> ::> for clause’ ‘step expressiom 
14? Cuntil clause> <do statement > 
do; 
call wenernte(bra): 
call genStwolsyvmincmp); 
call setSenter(typelap-t)):; 
end; 
148 for clause> ::= for “nssienment statement? 
do; 
if Ctypesp<>simvar?) or (astypesp<> int) then 
call error(‘ni’);: 
call generate(brs);: 
cail compilerSlabel; 
call setsymiocmp! codes ize); 
call literal€symlocs<p); 
eall iitload€sid-at:istaymlocep),; 
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end; 
149 <atep expressazlon* ::= step ‘exprersion> 
do; 
lf atypesp’>int then 
eall errorf‘ni’): 
stepSflag=trne; 
call atepSgen; 
end ; 
159 Cuntlil clause? ::2* “nntil non-term “expression 
do; 
cail generate(leq); 
call branchS8e lausel bsc) ; 


end; 

lesan “untill nonmvmterm <:= wntt! 
if not stepS8flag then 
do; 


eall gen8intSv( 1: 
call atepSgen: 


end; 
else 
atepSflag=-false: 
L352 do statement :': do simple statement? 
: 
133 C<elose statement» ‘::= close ‘identifier> 
call closeS$flie(sp'; 
134 i <elose atatement> , Cidentifier> 
call close8fille(sp); 
155 Csubprogram declaratiom <i: “subprogram head ing> 
155 “simple statement? 


do; 
eall lLiteral(symlocup) : 
cali generate(ungs) ; 
eall generate(rtn); 
call decr8blkSlevel; 
call setSenter(typemp)? ; 
eall literal(€symlocnip-2? ; 
call genSintS$v(9),; 
call gpenerate(sid),; 
pynum, pceonunt=9} 
fflage-false; 


end: 

156 <saubprogram heading’ ::= ¢function heading 
fflag=true; 

la | Sproceture heading? 


i385 Cfunctlon heading’ ‘:= ‘paramlieass functlom 
: 
139 ‘function 8&8 paramms> 
do; 
call generate(sv2); 
if ptest<>9@ and passl then 
call error(‘pd'); 


rd 


end; 
160 <procedure heading’ ‘:= “paraml2e2s proec> 
16 | | <proc «G params> 
dos 


call wenerate(sv2): 
if ptest<>o® ani passl then call error 'pd’); 
end: 


162 Cparamless function»? %‘:2 “<deelaration type? functiesn 
Lo. <identifier> : 
eall processSproc3decifsp-l.func.,stypemp) : 
163 function @ parame: %:5 <funetion head> Sidentifi«e-> ) 
do; 


call process#identSit-lCmppl. parr.) ; 
parme ,pteat=fpoceonnt.=peoint+ bP): 
call proc$8sav: 


end; 
16:4 | <fnuetien & params» 
1A+ Cert at jai 
160 PMc tromeie a! 2 = Nee dlacati- a tyne* funetion 
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/* 


163 Cidentifier® ( 
call procese$proc8$del(sp-!}.fune.stypenp?) ; 
166 maine tion tead> <aidentifier> , 
do: 
call process$identS8dc l€mppl.paran.©); 
peount=pcountt+l: 
end; 


Lav “paramless proc? ‘:2 proce-lurs “tdentifier? : 7 


do; 
call process$procSdel€mppl.pro.%:; 
call proc8sav: 
end; 
168 <proc 8 params)? *:2 “procedure head> ‘Cidentifier* ° : 
das 
call processS$lident$del(mppl.parw.™) ; 
parme ,ptest=(pceount:tpeount+]) ; 
call proc$sav; 


end; 
169 | “proc 8 params? ‘declaration? 
3 
179 “procedure head*> ::= procedure identifier) ( 
call process$Sproc3ic Li mppl, pro. 9); 
171 | “procedure head> Cidentifies” . 
do: 


peount=pcount+1; 
call process8ideont&d« i(mppl.parm,0? ; 


end ; 
le2 procedure call> ‘:= <eceall heading> ‘expression » 
do; 
peount=pcount+!; 
call checkparm(stypempi); 
call proc$8pro: 
if fpceount<> pcount and pass2 ‘then 
call error( pe’), 
end; 
173 Ceall heading» $$: Cidentifierd (¢ 
do; 
if (Cbt=processBident(mp))<>fune) and (b<> prod then 
eall error(’up’); 
call process$proc lb); 
fpcount=gmetparm: 
peount=9; 
end}; 
174 ' <call heading» ‘expression 
do; 


peount=peount+!; 
call checkparm(stypemp]1); 


end; 
175 Cexternal declaratiom> ::= ¢declaration type? external 
175 function ‘external list 
176 | external procedure 
174A Cexternal list> 
bec Cexternal fist> :: = <identifier> 
178 | “external I[list> , “identifier> 
179 case statement> ‘:= “case heading» ‘case block* 
dos 


do i=1 to n; 
call procesaBeagre®tiabe ll clahle-i!: 


end; 

call getSenter(typemp:: 
end ; 
130 Cease heading» ‘$22 cree expression of 
dy: 


if atypempl<> Int ther 


call error{'ni'’?!: 
call ewenS8intSv(.3): 
enll generate(mpi): 
ealtl setScomptlersdiarvet: 
call settypemple Iabde | 
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call generate(im2); 

call genStwo(getaddr-4+': 

call generatelsbr): 

call generate(bra) ; 
elable=clablet+i; 

call enterScompller tinbe l(@) ; 


n=8; 
end ; 
1S 151i <ease block? ‘::= begin Secase block body end 
i Las <case block hoadwv* ::2: <statement> 
call case8atate;: 
roe 182 | “ease hlock body? 3: “statemeut? 


call caseBstate; 
end: /*of case statements” 


end synthesize; 
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1% error recovery routines 67 
ee Re ae. TE SK eo eR oe Nh ihe EEK eee + 


noconflict: proc (estate! bytes: 
declave estate statesize, ‘4i1.j.k) indexsize: 
J= inmlexliestate);: 
k= j + index2(cstate) - §: 
do i = y to k;: 
if read1I( 1) = token tnen return true; 
end; 
return faise; 
end noconflict: 


recover: proc stateslze: 
declare tsp byte, rstate statesize; 
do forever; tsp = sp: 
do while tep <> 255; 
If noconflict(rstat=:tetatestackt tsp)) then 

do: 7k etate wil! read token */ 

if sp “> tsp then sp = tsp - 1: 

return restate; 


end; 
tsp = tap - 1; 
end; 
call acanner; 
end ; 
end recover: 
LS Mette tere ke fe ficsta ta ie te te eek ie ae Foe i ee oe one oe Re RO hk eee kh eR eR ee eS 
rap CEST KEES lalr parser routines Do Oo iO ly haa ge 
ve oe eee ee eee ee ee ee ee EE ee RR EE RK KEK Se RI oe 


do; /’*block for declarations*/ 
dectare (1,jy,.k) indoxsize. index byte; 


Initttalize: procedure: 
ecall title; 
call InitializeBacanne-r; 
call initializeBseyontl {; 
eall initializeSsynthesize; 
end initialize: 


metini: procedure [ndexsize: 
returm indexi(atate?; 
end getint: 


metin2: proeodure indexsice: 
returns index2€atote!: 
end gwetin2; 


x7 


7 


*/ 


KS 


K / 





Incap: procedure; 

ur (sp >= sp + 2) 
eceall error( ‘sa 

inesp; 


= 
— 


end 


lookahead: procedure; 


len@with(statestack) then 


et 


if notook then 
lo; 
entl scanner; 
notook = false; 
if liettoken then 
call print Stokeu: 
end: 


end lookahead: 


getS$varceSi: 
declare i byte: 
f* get vare. andl 
varc(wvarindex)=i;: 


if€var index: =varin-l- +1) 
eall error({'vo’ 


end setB8varc8i ; 


7*® initialize for input —- 
eall move! .rfcb..wfcb,9); 
call setupSintSfiles; 
call inttiatize; 


do forever: 
do while pass! or pass2; 
7* initialize variables 
compiline.nolook=true; 
sp=205; 
varindex.var 


0; 


do while compiling 


output operations 


“* ereate an output fille for code gene 


procedure( i}: 


increment varindeyr 7 


>» length! vare) then 


ar 


ee 


put filename in write feb *-/ 


“ated */ 


re 7a 
state-starts;: 


if etate<=maxrnce then “* read state */ 
do}; 
call tinerp: csctatestack(sp)izatate: 
t=wgetinl: call teckahead;: 
J=itgetin2-t; 
do i=l to jg: 
if rendif idz=token then “* save token */ 
do; var! sp) =varindex; 
Z#® copy accumulator to proper position "7 
do index = 9 to accum; 
call setS$varc3ilaccum( index)); 
end: 


hashfsp)=hashcode: 


/* save relative 


table location */% 


etatesread2( id: 
no loo k= true; 
ha 
ends; ofbfsea 
tieet= 1) then 
do; 
Cale: oer np is 
if€state <7 recover) =9 then compiling=ral=:: 
erd ; 
end; 
end: ajrRre 
lf state>maxpno then ~“ apply protluction state *- 
do: 


mp=ap-getin2; 


production 
call synthesi 
sp =mp; f=eet 


sar ladex= car’ - 


mppb=mpt+ bt; 
Yas MAX [11M 3 


4 ‘ 


= 


et 
i 





Jzstatestack(sp): 


do while (&:=apply1(@i)) 


i=1+1; 

end; 
if(state:= appiv2( idI=90 
end; else 


[oO eaind 4. <> ok: 


ther compiling = false; 


if state*S= maxino then ’* lookahead state */ 


do 3 


iz=gpetinl; call 


iz1l+l; 

end; 
agtate=look2( i): 
end; else 


4* push state */7 
do: call inesp: 
statestack(sp)= getin2: 
state=getinI: 
end; 


end; “* of while compiling 
end; /%of while passl or pass2%*/ 
listsource = false; 
listprod = false; 


listtoken = false; 
call inittalize; 


pass2 = true; 
end; /Ytof do foreverx/’ 
“* of block for parser = */ 


end; 
/*of block for declarations */ 


end; 


eof 


- 
« oan) 


ioxkahead;: 
do white (€K:=lookIfi*) <> 


0 and token <> k; 


7 





199h: /*load polnt for 


declare “*global literalsa*/ 


interp programt/ 


Lit literally “literally. 
true lit a ae 
faise lit "O° , 
forever lit ‘while true’, 
er lit “Odhb’, 
lf lit “Oah': 
declare “*op codes for algot-m machine instruct ions*¥/ 
deci Lit eg es 
atr lit alee 
int lit beso 
dcb Piet ers. 
brs Lit "34°, 
bec Lit ‘39°, 
im| lit 2 ioen 
im lit Bea 3 0 
declare ’*interface points fer ep/’m and interp*’ 
bdos Lit "OSh', 
boot lit Oli 
diskbuffloc iit ‘80h’, 
febloc bit “Sclro, 
diskbuffend iit *1900h", 
bdoebegin address initial(@6h), 
ma Xx based blosbegin address, 
buff address imitial(diskbuf fend), 
char based buff byte, 
filename address initial(€febloe), 
fnp based filename byte; 
declare “*builld variables*/ 
prtbase address, 
prtSaddr addreas, 
prtSentry based prtSaddr address, 
codebase address, 
codeptr address, 
atackbase address, 
curchar byte, 
switch byte initial€falee?!, 
bldSflag byte, 
b based codeptr byte, 
a based codeptr address, 
temp | address, 
tl based temp | byte, 
temp2 address, 
t2 based temp2 byte; 
/* deciarations for interpreter */ 
declare contz Lit ‘tah’, 
quo te lit Lech 
what Lit "63 3 
declare eolchar Lit “Odi, 
eoffiller Lit ‘lah’, 
Intrecsize lit oer 
4iskrecesize lit “42873 
stringdelim lit eee) 9 ee 
conbuffsize lit *B9°, 
console lit "AQ", 
nurstack Lit ‘48°, /*atack size times 4*/ 
maxSbikSlevel lit eS aer 
negative Lit aN 
positive Lit a 
declare ra addresea, 
rb nddvess. 
Re addrese, 


~t 
J 





declare 


declare 


declare 


c based 
twobyteoprand based 
sb address, 
st address. 
bra based 
ara based 
arb based 
brb based 
npr address. 
med addres3: 
inputbeffer 


buflfSspace(conhuffsize) 
inputindex 
eonbuffptr 
eon$char 
inputptr 
inputSchar 
num$read 
printbufflength 
printbufferloc 
tabpos l 

tabpos2 

tabpos3 

tabpos4 
printbuffer 
printpos 
printbuf fend 
rereadaddr 
input type 
fieldSlength 
sign 


based 


fileaddr 

feb 

febadd 

eofaddr 

buf ferSend 
recordS8pointer 
buffer 
nextdiskechar 
regS3iength 
blocks ize 
bikSleve } 
error$f lag 
blk( max$Sbl1k$leve 1) 
bytes$written 
firstfleld 
eofra 

eofrb 


(r@,ri,r2) C1t) 
fsignO0,signi,sign2) 
(dec8ptA,decptl.dec#pt2) 
er 


noSshift 

base 

bSbyte based base 
bSaddr based base 

ho Jd 

“8byte based holid 
hSaddr based hold 
ptrS8oane 

ptrStwo 

pone based ptrfone 
pst wo based pitrStwo 
atacktop 

retBaddr hased stacktop 
pebsptr 


pob@value based pcb@pir 
counter 

moveent 

ratSvalue 


re 


ra 
ra 
rb 
rb 


byte 
byte, 
byte. 
address 
based 


address, 


inputptr 


byte. 
lit 

lit 

Lit 

Lit 

Lit 

Last 
address 
based 
Lit 
address 
byte ’ 
byte, 
byte; 


address 
based 
based 
address 
address 
address 
address 
based 
lit 
address 
byte 
byte 
address 
address 
byte, 


address, 
address: 


byte, 
byte, 
byte, 
address 
byte, 
address 
byte, 
address 


addresea. 


byte, 
address 


address, 
addreas, 


byte, 
byte, 


addreas. 
address, 
address, 
address. 


byte. 


addrese, 
address. 


eonbuffptr 


byte, 
andres@, 


byte, 
aidress, 
address, 
hyte, 


initial(conbuffsize:, 


byte. 


hte, 


"184° , 
initial€printbevferloe), 


printbuffer hyie, 
“Octh’, 

fieaddr byre. 
fiteaddr address, 


record$pointer 
“25° , 


byte, 


initiai(€@2355°., 
initial(€fals-. 





tegatvalue address, 


tad! address, 
tad2 address. 
tad3J address, 
r$ptr byte, 
overflow byte. 
signifZno byte, 
eSf ley byte, 
s8flag byte, 


zeroSresult hyte; 


/*op/m interface routines*/ 


monl: procedure( function, parameter): 
declare fuuction byte. 
parameter addrese; 
goto bios: 
end mon!; 


mon2:‘procedure(funmction,parnameter) byte; 
declare function byte. 
parameter address: 
woto hdos;: 
end mon2; 


inond: procedure; 
gwoto hoot; 
end mond; 


printchar: procedure(char): 
dectare char byte: 
call montt2,char); 

end priutchar: 


print: procedure(buf fer) ; 
declare bnffer address; 
call mont(9,buffer): 
end print; 


erlf: procedure; 
call printchar(cr); 
call printchar( If) ; 
end crif;: 


/*® procedures for build */ 


open8intSflle: procedure; 
fnp(9) = ‘a's 


fnp( id) = °1'°; 

fnp( bid = ‘n'’s 

fnp( 32) = 8; 

if mon2(15,filename) = 255 then 
doy 


call print(. ‘ni 8°): 
call ecrlf; 
cali mond; 
end; 
end openS8intSfile;: 


readSintSfile:procedure bvte, 
return mon2(20,filename), 
end read@int#file; 


/*elobal provedures*s 


incbuf? procedure; 
if€bufF == buff*¥t) OF disckiufvtend then 
do; 
buff = diskbuffloc: 





if read@int$file “> @ then 
char = 7fh; 
end; 
end tuecbuf: 


sto8charSinc: procedure: 
b = char; 
ecodeptr = codeptr+1;: 
end stoS8char8inc;: 


nextSchar: procedure byte: 
eall tncebuf: 
return curehar := char: 
end nextchar; 


getS8twoSbytes: procedure; 
bC1) = nextSchar;: 
b = uextS8char; 

end get&two8bytes; 


incScodeptrStwo: procedure; 
codeptr = codeptr + 1 + I: 
end inc8codeptrdtwo; 


getparm: procedure address; 
return shi(double(nextchor’?,8) + nextchar;: 
end getparm; 


packS$dec imal: procedure( locSone, lLocStwo); 
declare switch byte, 
loc8one address, 
locS3two address; 


pack: procedure; 
if (switeh :*= not switch) then 
pBtwo = shil€p8one-30h,4); 7% odd ¥*/ 


else 
do: 
p3two = pStwo or (pSone-3O0h); 47* even */ 
ptr®two = ptr8two + 1; 
end} 
end pack; 


ptrSone = locfSone; 
ptrStwo = loc8two; 
switch = falee; 


templ = ptrStwo; 

pBtwo = 8; ; 
ptrStwo = ptrStwo + |; 
temp2 = ptr8two; 

pBtwo = 0; 

ptrStwo = ptr8two + 1: 


do whlle p€one ‘> QO; 
if (p8ene >= '@') and (p8one <= °9") then 
do; 
call pack: 
ti = ti-* 1; 
end; 
elae 
if pone = °.' then 
t2 = ti: “* left offset to decpt */ 
else 
do} 
error$Sflag = true; 
return: 
end: 
if (€ptrBone := ptr®onet+!i) = diskbuffend) and 
do; 
PtrSone = diakbulfflo-: 
if read@#int@#fite ©> 9% then 
do; 
pBonef2) = Tih: 
return: 


bidSi tare 


thes 





end ; 


end; 
end; 
if switch then 
do; 
ti = ti + f; 
ptr8two = ptr8two + 1; 
end; 
f2)=- ti = t2; “* Fimhtt offset to deecpt *- 
gra til 7 2; 
pStwo = ti + 2; 
ptr8two = ptrs8two + 1; 
p8two = positive; “7* this tietd used for dec sign */7 


end packSdec imal; 
“* procedures for Interp *. 


readchar: procedure byte: 
return mon2( 1,0); 
end read«har; 


read: procedure(a); 
declare a address; 
call moni(19,a); 
end read; 


open: procedure byte; 
return mon2(16;fiteaddr); 
end open; 


clogse:procedure byte; 
return mon2(16,fileaddr'; 
end clogae; 


diskread: procedure byte; 
return mon2(20,fiteaddr?; 
end diasakread: 


diskwrite: procedure byte: 
return mon2(2!1.fileaddr); 
end diskwrite; 


make: procedure byte; 
return mon2(22,ftileaddr)?: 
end make; 


delete:procedure;: 
call mon1(19,flleaddr'’: 
end delete; 


setdma: procedure; 
call mon!i(26,huffer): 
end setdma; 


select: procedure(drive):; 
declare drive byte; 
call moni(1¢,drive); 
end select; 


maski procedure( location) addreea: 
declare tlocattion address, 
l based Jocation aldrege: 
return | and Obf f fh: 
end mask; 


checkS8intSeign: procednre(valtuc) byte; 
declare value address: 
if rolChigabf value). 1) th » 
return negative; 
else 
refurn positive; 
end checkrSintSs len; 


q ww 
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check$S$int: procedure(stackBlo-' fvte: 
dectare stackS8loc adlres=: 
if-notCrolthigh€stach#loc:.2)) then 
return true; 
else return false; 
end checkSint; 


checkStewp: procedure(stackSt--' byte: 
declare etackSloc address: 
if (rol Chigh(stack#Floc).ii)} and 
(rolChigh(stack$loc!.2)) then 
return true; 
else retnrn false; 
end checkStemp: 


setSup8neg: procedure; 
if not checkSintSsienlarsa then 
ara = ara or 4000h; 
if not checkSint8sign(arb: then 
arb = arb or 4000h; 
end setSupSneg; 


check$nec: procedure; 
if not checkhSintSeign(arh! tien 
arb = arb and Obfffh: 
end checkS8neg: 


popS8stack: procedure; 
declare num byte: 
ra = rb; 
if check$tempfar>* then 
Cb - Pb — (brr=2): 
else rb = rb - 2; 
end pop$stack; 


push8s tack: procedure(num?; 
declare num byte: 
rb = ra; 

a = ra + num: 

end push$stack:; 


3 


move :procedure(source ,dest ,connt; 
declare source address. 
dest address. 
count byte, 
schar based source byte, 
dchar based deri *yte: 


do while(count ‘$= court - $) £) 255 
dehar = schar; 
source = gource + 1; 
dest = dest + IT: 

end; 


end move ; 


fill:procedure(dest.char.n); 
“*fI111 locations starting at dest wi 
dectlare dest address, 
n byte, 
A based dest byte, 
char byte; 
do while (ni2en-1) (> OF Fh: 
d = char3 
dest = dest + 1; 
end; 
end fi11; 


errorSmeag: procedure! mer’: 
declare msg address: 
eall print8char(' ‘); 
Caml printSchar(€hiah' ina!) : 
call printS-har( lowCis,) 
end error$msg: 


aga e: 


@ 
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th char for n hytes*/ 





warning: procedure(warncode) 
decilrre warncode addiv«ss 
ealloerltf: 
call print(. "warning $'): 
call errorSasy(warncode) ; 
end warning: 


ee ae 


error: procedlurel(errcode);: 
declare errecde addresa; 
eall erlf: 
errorSflagr = true; 
call print(. ‘error 3°); 
call errorSusglerrcods); 
end error: 
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initializeSdiskBbuffertproce-iire; 
eatl Fil buifer,eoftitier.i2%); 
end initializeSdlsk$Shuffer: 


bufferSastatusSbyte: procedure byte: 
return feb 33); 
end bufferS8statusSbvte; 


setSbufferS$statusSbyte:procedureistatus);: 
declare status byte: 
feb(33) = status; 

end setSbuffersSstatusSbyte: 


writeSwark: procedure byte; 
return bufferSstatusS3byte: 
end writeS3mark; 


setSeriteSmark: procedure: 
call setS$bufferS8statusthyte! bufferS$statusSbyte 
end setSwriteSmark;: 


clearS$writeSmark: procedure; 
call setS$baffer8statusSbytebufferSstatusSbyte 
end clear$writeS8mark; 


activeSbuffer: procedure byte: 
return ghr(bufferS8statusSbyteo.1); 
end activeSbuffer; 


setS8bufferS8inactive: procedure: 
call set#buifer®statuseSbytelbuf ferSsatatusSbyte 
end getSbufferZinactive;: 


setB8bufferSactive: procedure; 
call setSbufferS$status$byte(bufferSstatustbyte 
end setSbufferSactive; 


setSrandom8node: procedure; 
call set$buffer@statuseSbyte: bifferSstatus&byte 
end get$random8mode: 


random8mode: procedure byte; 
return rol(buffer€statusSivte.)); 
end random@node; 


diskSeof: procedure, 
lf eofaddr = ® then 
call errorf‘ef'); 


re = agafaldr + |]: 
ra = eofra; 
rb = eofrb; 


moto eofexit; 
end diskSeof; 


or 6th): 


and Ofeh!: 


and 9fdh>: 


or O@2h); 


or 80h), 





riliSflileSbuffer: procedure; 
if diskread = 9 then 
do; 
ealli getSbufferS8active: 
return: 
end: 
if not random8mode then 
do; 
call disk$eof; 
return; 
end; 
call initialize8diskS3buffer: 
call setSbufferBactive:; 
return; 
end filiSfileSbuffer; 


writeSdiskSifS8req: procedure; 
if writeSmark then 
do; 
if diskwrite <> @ then 
call error('dw’); 
call clearSwriteSmark: 
if randomS8mode then 
call setS8bufferSinactive: 
eias 
eall initializeSdiskShaffer; 
end ; 
recordSpointer = buffer; 
end write8diszk$if$Sreq;: 


atSend8diskSbuffer: procedure hyte;: 
return (record8pointer := reeord$pointer + 1) >= bufferFend: 
end at#end8diskSbuffer,: 


varSblockS8size:procednre hyte: 
return blocksize <> OO; 
end varShlocksize; 


storeSrec8ptr: procedure} 
febadd( 18) = record$pointer: 
end store8recS8ptr; 


writeSaSbyte:procedure(char): 
deciare char byte; 
if varSblockSsize and (bhyteswritten °*= hyteswrittent!l) 
>» blocksize then 
call ervor(’er'); 

if atSend$diskSbuffer then 

call writeS8diskS8iffreq: 
if not activeSbuffer and randomSmode then 


‘ 


do: 

call fililSfileSbuffer;: 

febt32) = feb(32) ~ i; “*® reset record no */ 
end: 


néxtdiskchar = char: 
call set&®writeSmark; 
end writeSaSbvte; 


eetSfilteSaddr: procedure: 
pr¢eSaddr = mask(ra): 
fileaddr = prt@entry: 
eofaddr = fehadd€ 19): 
call pop8etack:; 

end set®fiiefaddr: 


setSfileSpoluters: procedure: 
bafferSend = (buffer :: fileaddr + 33) + diskrecsize: 
recordpolinter = febaddt Ic): 
blocksize = febadd(!V); 
call setdma, 
end set$fileR®peinters;: 


setupSfileSerientt procedure, 





? 


if open = 255 then 
do: 
if make = 255 then 
eall errorf‘me’): 
end; 
end setupSfileSexteant; 


diskS8open: procedure; 
lectnare (filenante,. buff. bikSsize) address. 
: (i.j) byte, 
char based buff hyte:;: 
inc8y: procedure byte: 
return (jy := y + I): 
end iInc8j; 


prt@addr = mask(ra); 
ceall popSstack; 
'bik$size = ara; 

cail popS8stack; 

buff = mask(ra);: 

call pop$stack: 

buff = buff - char: 
fileaddr.,prtSentry = ra: 
buffer = ra + O; 


eall f1lll €C€fllename <= ra + 1).° ‘,11): 
If echar(2) = °:* then 
do; 


bra = (char(1) and Ofh) - 1: 
i = char —- 2; 
buff = buff + 2: 
end; 
else 
Le= char: 
if i>» 12 then 
i = 12% 
buff = buff + 1; 
j = 2355; 
do while fechar€incSy) <> *.°) and (Cy < 8): 
end; 
call move (buff, fllename, j!; 
if 1 > inc$j then 
call move (.char(y).filenuame+8. i-g); 
call setupSflleSextent; 


ara( 19) = @; 
ara(l@) = ra + 256; 
araC it) = bIkSsize;: 


ra = ra + i68; 
end dliakSopen; 


setSeofS8etack: procedure; 
eofra = ra; 
eofrb = rb; 

end setS8eofSstack; 


setupSdiekSlo:procedure: 
call getS8fileSaddr: 
call set#fileSpointers: 
bytes8written = BO; 
firgstfleld = true; 

end setup8disk8io; 


random@setup: procedure} 
declare bytecount addreas. 
record addresea, 
extent byte; 
if mot var$hlock$a ize then 
call error(‘’ru’):; 
ara = ara - Il: 
call setSrandom8mode@; 
call setBburferBinactive: 
call writeS3divk3i fSreq; 
bytecount = bloceksize ¥* ara: 


recordpoimiter = (byt- count and Tehh) + buffer - 1; 





call store#recSptr: 
record = shr(bytecount, ©); 
extent = shr(€record,.<); 
if axtent ‘> feb(J2) then 
do; 
if close = 255 then 
call error('ce’*); 
feb( 12) = extent; 
call setup8fiteSextent: 
end; 
feob(32) = lowlrecord) and rh; 
call popSstack; 
end randum$setup; 


getSdisk$char: procedure hyte; 
if atSendSdiskSbuffer then 
do; 
call writeSd iskSifSre y; 
eall fillSfileSbuffer: 
end; 
If not activeS8buffer then 
eall fill#®fileBbuffer: 
if nextdiskKkchar = eoffilteor then 
call disk8eof; 
returu nextdiskchar; 
end getSdisk$char; 


diskS8c loxe: procedure; 
call setSfileSpointers: 
call writeSdisk$if$req; 
prtSaddr = mask(ra), 
if close = 255 then 

eceall error('’ce’): 

prtSeutry = @; 

end disk%c lose; 


clear$print#buff: procedure; 


call fFill(Cprintbuffer := printbufferloc),’ 


end clear8priutSbuff; 
dump$printS8buff: procedure; 


deciare temp address, 
shar based temp byte; 
temp = printbuffend; 
do while char = * °; 
temp = temp - 1; 
end; 
eall erlf:; 
do printbuffer = printbufferloc to temp; 
call printchar(printpos); 
end ; 
call clear8$print8biuff; 
end dumpSpriutSbuff; 


load$Sprint$buaff:procedure(char): 
declare char hyte; 
printpos = char; 
if€printbuffer <7 printbuifer +1) > 
printbuf fend then 
call dumpSprintSbiff: 


end loadSprintSbuff; 


output: procedure(desrt,char?; 
declare dest byte, 
char byte; 


If dest = eonsole then 

eall printSchartchar): * to console */ 
else 

call writeSaShytefechart; “% ta disk ¥/ 


end ontputs 


writeSdec!i procedurelanupes, lost): 





declare sonrce address. 
num byte, 
numSdig@its byte, 
char byte, 
Index byte, 
dest byte, 
count byte; 
store@one: procedure; 
if (switch := not ewitech? then 
do: 
ehar = shr(h8byte.4:? or ‘0’; 
if Ccount=9) and (char='9') then: 
else 
call onutput(dest,chew): 
end; 
else 
do: 
call outputldest.(uShvte and Ofh' or 
hold = hold +r (: 
end: 
count = count + 1; 
end storef$one: 


hold = source; 
sign = h@byte( 1); 
if sien or 90h then 
cali output(dest,* °); 
else call ontput(dest,'-')3 
count = 98; 
hold = hold - hS8byte; 
num8digits = h8byte * 2; 
hold = hold + 1; 
num = numBdigmita - h&hyte; 
awitch = false: 
hold = hold + tL; 
do tndex = 1] to numS8digits-i; 
if count = num then 
do; 
call output(dest.’.°): 
count = 190; 
end; 
else 
call store8one; 
end; 
end write«S8dec;: 


writeSstr:procedure(hold.dest’: 
declare hold addreesa, 
h based hold hvte, 
dest byte, 
index byte: 
hold = hold - h;: 
do index = I to h: 
call output(dest,ht index)); 
end } 
end write8str: 


writeSint:procedure(valite,dest?’; 
declare value address. i hxte, count byte: 


ES ps 


dectare decint(3S) addresa inititall 1HEONY, 1996H,1909,19,1); 


declare (flagw,dest) byte; 
Sign = checkSintSeignt valu’; 
if sign = negative then 


dot 
value = -value and ObFrTh: ~—* mask of fF next 
call output(Cdest,.'’-'): 

end; 


else call cutput(dest." °): 
flag = falee, 
do { = 9 two 4: 
count = 30h; 
da while value >= dJeeint' id: 
value = vatne -— dee imtl td; 


tf.3 


to 
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flag=true:r 
count=count+1; 
end; 
if filawe or (1 >= 4) then 
call output(dest.ceni); 
else 
call output(dest.° (3); 
end; 
end writeSint:; 


writeStoS8disk: procedure( type), 
Yk type O-integer, type I-dvectual, type 2-string */ 
declare type byte; 
if type = 9 then 
call writeBintlara.i);: 


if type = |! then 
cali write@declara,!|); 


if not firstfield then “¥ separate fields with commas */ 


call wrtte®aSbyte(’,'); 
eisge firstfield = false; 


if type = 2 then 
do; 
call writeS8aSbyte(qnuot>’>; “* strings put in quotes *.’ 
call write8str(ara, 1); 
call writeSa8bytel( quotas: ; /7* add trailing quotes */ 
end ; 
call pop8stack; 
end writeStoS$disk:; 


concatenate: procedure; 
declare (sizei,size2,t$aeize' byte; 
temp! = mask(ra); 
call pop$S$stack; 
if not checkStemp(Cara) then 
do: 
temp2 = mask(ra) ; 
temp2 = temp2 - td; 
#ize2 = t2 + 1; 
call move(temp2,ra,size2); 
end; 
else 
do; 
gize2.= bra; 
ra = ra - bra: 
end; 
temp! = templ - ti; 
Sizel = ti; 
call move(Ctempi+!i,rat+sizec,sizel); 
t8size = size! + size2;: 


bra = tSsize - 1}: 
ra = ra + t8$size; 
bra = tS8size; 


bra(1l) = @cOh; “*® set temp bits *F/ 
end concatenate; 


convertSto8int: procedure loc,size)? address; 
deciare decint(3) address initial € 190800, 1960, 1980,10,1). 
loc addregas, 
hold address, 
h bused hold byte, 
num address, 
Cin jJveize) byte: 
num = 0; 
= 3: 
hold = loc + size - 1}; 
lf @ize > 3 then 
call errar(€ in’); 
else 
do} 
do 1! = 1 to e2ize; 


ores 





num = num + (Ch ~- 39h! * decint(yi=g-1): 
hofd = hold - 1; 
end 3 
if num ‘= 1%383 then 
re teary ream; 
else 
call errort’io'); 
end; 
end convertStoSiiut: 


one@left: procedure; 
declare ctr bvte; 
if shr(bSbytett),4) = O tien 


do: 
do etr = 1 to 9; 
bPSbytel(etr) = shl€hSbryteCcetr),&) or shr' 5Sbytelctrt+i).+); 
end; 

end; 

else noSshift = true; 


end oneSi-ft; 


oneSright: procedure ; 
declare ctr byte, 
index byte; 


Gtr — eli: 
do tndex = {| to 19; 

car = ctr=—1; 

bBbyte(Cctr) = shr(bSbytelctr) .4) or sini€bSbytel(ctr-1) ,4::; 
end; 


end oneSright: 


shift$right:procedure(count); 
declare(count,ctr) byte; 


do etr = 1 to eount; 
call oneSright; 
end; 


end shiftsSright: 


shiftSleft:procedure(count); 
declar= count byte; 
noshift = false; 
do etr = 1 to count; 
call oneSBleft; 
if noshift then 
return; 
end; 
end ahift%left; 


leadingSzeroes: procedure(addr! byte; 
declare count byte, 


© tr byte, 
addr address; 
count = Of 


base = addr; 
do etr = 1 to 9; 
if (b8bytel(ectr) and OFOh) <> OD then 
return count; 
count = ceunt + 1; 
Lf (b8bytelCetr) and OfFh) > @ then 
return count; 


count = count + 1; 
end; 
if base = .r9 then 
do; 


call error('dz‘); 
bBbhytel9) = iOh; 
decpt@ = |: 
return 16; 
end: 
return count; 
end leading&zeroes; 


riSgereate:: procedure byte; 





declare (i.ctr) byte; 
do ctr = 1 to 93 

if rifetr) > (1 3s 

return true; ; 


if rifetr) < 1 then 
return false; 
end; 
e8flag = true; 
return true; 
end riSgreater; 
allign: procedure; 
deciareiz,y) byte; 


rightS$op: procedure(addr) ; 
declare addr address; 


if noshift then 
do; 
base = addr: 
call shift$right(y := ¢ 
end; 
end rightSop: 
y = 0; 
if decSpt9 > decSpti then 
do; 
base = .rl; 


cali shiftSleft(x := 
decpt1l = decptl + ctr~-i; 
call right8op(.rQ@); 


decpt® = decpt® - y; 
end; 
else 
do; 
base = .rQ;3 


cail shift@left(x ‘= decpttl 
decpt@ = decpt@ + ectr-1; 
call rightSop(.rlI); 
decpti = decptlI- y; 
end; 
end aliign: 


add$r®: procedure(second,dest) ; 


declare (second, dest) addregs, 
hold = second; 
base = dest; 
cy = 8; 
ctr = 10; 
do index = | to 11; 
a= rA@lctr);: 
b = h8byte(ctr); 
i = decla + cy); 
cy = carry and |; 
i = dec(i + b); 
ey = fey or carry) and ft: 
bSbytel(ctr) = i; 
ctr = etr - ls: 
end}; 
if cy then 
do; 
ctr = 10: 


do Itndex = 1 to It: 
{ = bS8byte(ctr) 
1 = dac(i + cy) 


: 
carry and 1; 


cy = 
bShyte(ctr) = i; 
Gatre=- cir = 1; 
and; 

end}; 


end addS@r; 


compliment: procedure( numb? : 
declares numb byte: 


1lAS 


(99h—-rO@letr))3 


decptA - 


taen 


= Ctr: 


- decSpti); 


Cindex,cv 


decpti):; 
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‘do case numb; 


hold = .r9;3 

hold = .ri; 

hold = .r2; 
end; 


if glenSOCnumb) then signSC numb’ = negative; 
ela#e signSOC numb) = positives; 
do ctr = @ to 190: 
hSbyte(ctr) = 99h - HSbyielctr): 
end | 
end compliment; 


rightSjustify: procedure(numpb?: 
declare (mumb.i) byte; 
do case numb: 


base = wr; 
base = .rl; 
base = .r2; 
end; 
i= 6; 


do while ((€Ci:=i+2) < decp*t@(numb)) and (bSbytet(9)=9)); 
eall shiftSright(2): 
end ; 
decpt9@€( numb) = decptOCnumbh) - © '-2); 
end rightS8juastify: 


getSmultSdiv: procedure; 
noshift = falae,; 
if (sign@ and signl) or 
(not sign@ and not signi) then 
sign2 = positive; 
elge sign2 = negative; 
call fill €.r2,0,18); 
end setSmultSdiv; 


add@series:procedure(conunt?;: 
declare Ci.connt) bvte; 
do i = 1 to count; 
call addSre.r3,.r2?; 
end; 
end add$Sseries,; 


multiply: procednare( value): 
declare value byte: 
if value <> ®@ then 
do; 
if noshift then 
call error('‘ov');: 
call addSeerlea(value’l: 
end; 
base = .rQ@; 
call oneSleft; 
end multiply; 


divide: procedure; 
declare (i,j,k.x,1z@.1z1) byte: 
call setSmultSdiv; 
s8fiag = true; 
eSflag = falses 


if (1290 := leadingSzervons( 93) ¢> 
€izl := leadingSzeroeal.rli' then 
do; 
if 1z2@ > I2zl theu 
do: 
bnae=.r9,; 
call ahiftSte ft i:=i'2zA-Izi): 
decpt® = decptA + i; 
x = Izil; 
end; 
else 


do; 
base = .rt: 
call shiftSloeft( t:tlei-isf): 





decBptil = decpti + i; 
iz@; 


x = : 
end; 
end; 
else x = Iz): 
decpt2 = 19 - x + decpt!l - decpt9; 
call compliment(90); 
do i = x to 19; 
poe 
do while rl8greater ani sSflag; 
enil addSr@l.ri.,.ril?: 
Jae Pgh: 
lf eSflagw = true then s8$flag = false; 
end ; 
kK@=—shr( i. 1); 
if i then 
roCk) 2. retn) or J; 
else r2(k) = r2Ck) oF ahi y,4): 
base = .rQ@; 
call oneSright; 
end; 
end divide; 
echeck$Sresult: procedure: 
if r2 = 99b then 
do; 
call compliment(2); 
sign2 = sign2 xor 1: 
end ; 
else 
do; 
if r2 ©>@ then 
eali error(‘ov’): 
if not s8flag then 
gignl=positive;: 
end; 
end check$result; 
check8s ign: procedure} 
s@flag-false; 
if sigu9 and signi then 
do}; 
gign2 = poaltive; 
return; 
end; 
sign2 ~ negative; 
if not sign® and not signi then 
do; 
s8flag-true; 
returns 
ends 
lf sign® then call compliment( 1); 


else call compliment(9); 
end check$s ign; 


add: procedure} 
call checkS8s ign; 
call add$SrO0(€.rl,.r2); 
call check$result; 
decpt2 = decpt®@; 

end add; 


epyBreg28ons tack: procedure: 
declare count byte, 
i < byte; 


eall right$justify(2); 
call pop8etack; 

count = 9; 

base = .r2; 

1 = 10 = (deept2+i) 2: 
do while (bSbyte = 0) and 
baze = hbase + 1; 
count = count+ 1; 


feount 


fees ee 


{AG 





end; 


ra = rb + 2; 
bra(@) = (count := JA - count); 
bra( 1) = decSpt2; 


call move(base, rat2,count': 
bra(countt+2) = countt+2; 
bred (coant+3) = gign2 or OcOh: 7* set sign and 
ra * ra + count + 2: 
end cpy8reg23ons tack; 


loadS8reg: procedure(source.reg ism? ; 
declare source address, 
reg8num byte, 
count byte: 
hold = source; 
if not check8temp(hS$addr) then 
hotd = mask(C hold) ; 
sign@(Creg8num) = h8byte( 1); 
hold = hold - h8byte; 
count = hS8byte; 
do cage reg€num: 


base = .r@®@; 

base = .rl; 

base = .r2; 
end; 


call f£lilCbase,90.11); 

hold = hold + 1; 

decSpt@(reg8num) = hSbyte:; 

hold = hold + 1; 

call movethold, baset10-count,count); 
end load$reg; 


setSup8regcs: procedure; 
noshift = false; 
call loadSrege(ra,9); 
call toadSreg(rb, 1); 
call right$justify(9) ; 
call rightS$justify(1); 
end set8upS8regs; 


step8inseScnt: procedure(nnum) ; 
declare num byte; 
re=rctnum: 

end step8ins8cnt; 


branchS$absolute: procedure: 
call step8ins8Scnt( 1); 
re=twobyteoprand - I; 
end branchSabsolute: 


wetBcodeBaddr: procedureloffset: address; 
declare offsct address; 
return codébase + offset; 

end get@code8addr; 


getEprtSaddr:procedure(loffset: adiress; 
declare offset address: 
return prthbase + offset; 

end get8prtS8adir; 


load: procednre(addr) ; 
declare addr address. 
a based addr addroas;: 
prtSuddr = mask(addr): 
a = prt®-ntry: 
end load; 


storeS8dec: procedure(gourcre ole sit: 
declare (source dest,destSsiun) address, 
ConmtSsto,avail#aty .-ictbytes) byte. 
a based source addre-s, 


TRA 


temp bits ¥v 





d based degvt address, 
decpt byte, 
Sign based destS$n igen byte; 
if checkStemp(a) then 
templ = source; 
elee templ = mask(source): 
temp2=mask(deat); 
availSsto = t2 - 2; 


dest8aign = temp2+1; 
t2(01) = tll) and Olh: /“*rask off temp dits */ 


source: (tempt:ttempIl-tl): 
desgt=temp2-t2; 
amt@Sato = tl; 


decpt = t1C1); 
sigSbytes = (CamtSata * 2 - decpt) + 1) 7 2; 


if amtteto “= availSsto then 
do; 
call fill€dest,9O0h,t2:; 
call move(source ,deat.t1+2); 


end; 
elae if sigSbytes <= availS$sto then 
do; 
call move (source .dest.t2):; 
temp2 = dest; 
t2 = availssto:;: 
t2(1) = CavalilSsto - sigSbytes) * 2; 
if decpt then 
t2C1) = #201' + I; 
call warniug('il’); 
end; 
else 
do; 


hold = dest; 
hSaddr = 010th; 
hSbyte(2) = 10h: 
sign = positive; 
call error(’sl’); 
end; 
end storeS$dec: 


storeSint: procedure(dest,value); 
declare (dest,value) address; 
prtSaddr=mask(dest);: 
prtS8entry=value; 

end storeSlint; 


storeS8str:procedure(source,dest?; 
declare (dest,source) address, 
3 based source address, 
d based dest address; 
if check8temp(s) then 
temp! = source; 
else templ = mask(source);: 
temp2 = maek(dest); 
dest = temp2 - t2; 
gource = templ - ti: 
if tl “= ¢2 then 
do; 
eall fill( deat, 20h, t2): 
call move(souarce.dest,til): 
ends 
else 


do; 
call movelsonrece.dest.t2): 


call warning('s0'); 
end; 
end storeS%str: 


allocateSatr: procedure: 
lf bra = G8 then 
do; 
call error 'az’): 
bro = 10; 
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end; 
call push@€stack(Cbra:=hrat+t): 
bra = brb; 
end allocateS8str; 


allocateSdec: procedure: 
declare store byte; 
if bra = 9 then 


do; 
enll error('az'): 
bra = ‘de 

end; 


etr = bra; 
store = (brati)/2+2; 
call pushSstack(store?);: 
bra = satore; 
ara = ara or 91060h; 

end allocateSdec; 


sgetSup8alloc: procedure; 
prtS8addr = mask(ra); 
call popSstack; 

end setS8upS8alloc; 


find$Srb: procedure; 
if check3temp(lara} then 
rb = ra —- (bra + 2); 


elae rb = ra - 2:3 
end findSerb; 


sav@€pcb: procedure; 
if moveScnt = 6 then 
return; 
call pushS8etack(2) ; 
call movelpebptr,ra,move8cnt) ; 
pebSvalue(l) = ra; 
ra = ra + moveScnt; 
ara * moveScnt; 
end sav8pcb; 


unsave:procedare; 
call move(templ!*ra-ara,bold,ara); 
rao2 templ { 

end unsave; 


calc8row: proce-:lure; 

declare (Index,num,v,a$size.type) byte, 
(num8arrays,numSdim,alloc8len,count, i) 
d ((0®) byte; 

type = bra: “’* I-int,2-dec,3-str */ 

call popS8stack; 

numSarrays = bra; 

call pop8stack: 

num@dim = bra; 

call pop8satack: 

v2 @; 

aS8size = I; 


d(num$d im) 1; 


if num$dir: I then 
do; 
a8¢gize = bra - brb + I: 
v = brbe 


call popSstack; 
call pop&8stack;: 


end: 
elge 
do index = | to num8dim: 
{ = nanrSdim - tnder: 
a@size = sfsize * fuum := hra - brb + 1): 
d( i’ = num * dC t+); 
v =v * bPrb * df t+): 
call per satack 


call popfetack: 


-— 
ant 


byte ° 





end; 
if type 


int then 


call pushSstack(2); 


else 


allocSien 


do count 


bra; 
1 to num$arrays: 


call stepBins8cnt( 1): 


bra = cl); 
bra(1) = c and fh; 
prtSaddr = ara + prtSbase: 
prtSentry = ra or 4@00h: -* set addr bits ¥/ 
bra = uumSdim; 
if num8dim <> 1 then 
do index’ = 1 to num$dim -i; 
i = numSdim —- index: 
ra = ra + l¢ 
bra = di); 
end: 
ra = ra + ts 
bra = v; 
ra = ra + 1; 
bra = allocS8len; 
if type = int then 
do; 
bra = 2: 
ra = ra + 1; 
hold = ra: 
ra = ra + aBeize * 2; 
h8addr = ra; 
end; 
else 
if type = decl then 
do; 
bra = (bratl)/72 + 4; 
ra = (hold := rati? + 23 
bra = allocS$len;: 
do index = | tn aSsize; 
call allocatetdec: 
call push$stovk(2); 
bra = ctr; /* reset to allocated length */ 
end; 
call pop8stack; 
hSaddr = ra; 
end: 
e leo 
if type = str then 
do; 
bra = bra + 3; 
ra = (hold ‘= ra + 1) + 2; 
bra = allocSlen: 
do index = 1 tu aSdsize;: 
call allocateSstr; 
call push8stackf 2); 
ara = arb: 
end 3 
call popSstack: 
h@addr = ra: 
end; 
call atep@insScnt( 1); 
end; 7“Scount ¥*/ 
end calcS8row: 
cailcSeub: procedare: 
declare arrayS8addr address. 
location Address, 
aSbyte based arraytaaedr byte, 


aSaddr based arravtaddr 


(ji 
of 
arrayfaddr 
call pops 
offeet 
numSdim = 


addrese. 
enum&diimd byte. 

fset addreas: 

= mask(rn);: 

tnek; 


ATat 


rshyte; 


i 





do 1 = 2 to num8din; 
call popSstack; 
arraySaddr = arraySaddr + 
offset = ara * aBbvte + of 
end; 
arraySaddr = arraySaddr + 1: 
offset = (offset - aSbytetl) * aBbyte(l);: 
arraySaddr = arraySaddr + 2: 
if (location! *arrayS8addrt+ofitset) > aSaddr then 
call error(’sb'); 
ara = location or 48000h; 
end calcS8eub;: 


I: 
t 


sets: 


decrementSbik: procedure(num) : 
declare num byte; 
ra = bik€(bIkS8level:=bikSlevel-num) + 1); 
call findSrb; 

end decrement#blk: 


addSint:procedure(Cintl.int2) address; 
declare (intl, Int2) address; 
return intl + int2; 

end addSint; 


sub8int:procedure(Cintl,int2?' address; 
declare Cintl, int2) addresi. 
return intl - int2; 

end subSint; 


mulSint:procedure(Cintl.,int2) address; 
dectare (Cintt!,int2) address: 
return Intl %®% int2; 

end mulSint; 


div8int: procedure(Cintl.int2) address; 
declare (Cintl,int2) address; 
return intl 7% int2; 

end divSint; 


exitSinterp: procedure; 
cali erlf: 
call mond: 

end exitSinterpys: 


conso leSread: procedure; 
call crif; 
call printchar('-'),; 
gall printchar(’>'); 
call printchar(' ‘); 
call read(.inputbuffer?; 
if buffS8space(1l) = contz then 
call exitSinterp; 
num@read = buff8espnce;: 
conbuffptr = .buff{8espace: 
buf {Sspace(buffSepace+l1) = solchar;: 
end console8read; 


moreSconS8input: procedure byte; 
return conbuffptr < .buff2sivace( numBread); 
end moreSconS8input; 


consoleBinputSerror! procedure: 
re = rereadaddr: /’%*% reset prowram counter */7 
call warning ('11'°); 
moto errorSexit; “* return to outer level */7 


end consoleSinput8error: 


get8con8char: procedure bytc; 
conbuffptr = conbuffptr - 1: 
return con&Schor; 

end gwetScon@char; 


, ened a } 
#o¢ s 





next€input8chsr: procedure byt=; 
if inputtype = @ then 7” r-ad from disk »*” 
Yk do forever; 


if (CbuffSspace(inupntindex)d °= getdiskehar) = If then 


do; 
if varSblocksiae then 
eall erroré‘re’): 
end: 
else 
return next€@diskSchar: 
end */; 
if inputS8type = 1 then “¥ inpnt frpm console */ 
return getSconS8char;: 
end nextS9inputSc har; 


getSfield: procedure; 
declare hold byte, 
delim byte; 

fieldSlength = 6; 

do while (hold *:= nextBinputfchar) = ° ° 
end: 

{tf inputtype = O then 
inputptr = .buaff8space; 

if inputtype = | then 
inputptr = conbuffptr;: 

if hold <> quote then 


delim = ° ‘'; 
elge 
do; 

delim = quote; 

hold = nextSinputS$char: 
end; 


do while Chold ‘> delim) and fhold <> eo0lchar);: 
fieldStength = fieldSlenetn + 1; 
hoid = nextSinputS$char; 
end; 
end getSfialds 


getSintSfield: procedure; 
declare sign byte; 
call getSfield; 
if inputSchar = ’-* then 
do; 
sign = I; 
inputptr = inputptr + 1; 
fieldSlength = fieldBileneth - 1; 
end; 
else 
if Input8cehar = *+° then 
do; 
sign = 6; 
Inputptr = Inputptr + 1; 
fieldSlen@th = fieldSleugth —- 1; 
end ; 
else 
gign = @; 
call push8stack(2) ; 
ara = convertSto8int(inputpir. fie ldSlength): 
If error8fing then 
call consoleS8input$error;: 
if sign then 


ara = -ara and Obfffh;y “" set neg bit ond conv to neg 
end getBintSfie Jd; 


get€strSfield: procedure; 
call get@field;: 
con8chnr = fleldSlength+!: 
InputSptr = conbuffptr - eoanehar: 
inputSchar = fleldSlemeth: 
call pnuahSstack( 2); 
ara = conbuffptr or 4000); 

end gwetSstr@field; 


int 





getSdecSfleld: procedure: 
call get8fieltd; . 
call puesh$stack(2) ; 
con8char = 0; /7*® set binary 98 as end of dec */ 
If InputS8char = '+* then 


do; ; 
sign = 1; : 
inputptr = inputptr + 1¢: 
end: 
else 
af inputSchar'? *-’ then 
do; 
Sign = 9; 
-inputptr * imputptr + 1; 
end: 
elde 
vign.= [ys 


call packSdecimal( Inputptr.ra): 
Lf errorSflag then 
call consoleSinput8error: 
ra = ptrStwo - 1; 
bra(!l) = sign or OcOh;: “* set sign and temp hits */7 
end getSdec8fieid; 


Initilalize8execute: procedure: 
stackton=3950h; 
med. rc = codebase; 
mpr = prtbase; 
st, sb = stackbase; 
ra = (rb := 3b) + 23 
bld8flae = false; 

end initlalizeSexecute; 


/*kaet up machine*/ 


call print(.‘algol-m Interpreter-vers 1|.98°); 
emil crit; 

call open$intSfile; 

bld$Sflagw = true; 

call Incbuf:; call tnebuf; “* skip codesize */ 
prtbasge = .memory; 

codebase = getparm + prtbase: 
codeptr=codebase; 


/*iload machine */ 


do while next#char <> T@fh: 
tf curchar %= 128 then 
do; 
call stoS$char8Inc; 
cail incbuf;: 
call sto®charS8inc; 
end} 
else 
if curchar = str then 
do; 
call sto8char8inc; 
templ = codeptr:;: 
char = ®; /“*® set initial length to zero */ 
eall sto3char8inc; 
do while nextSchar <> ®%:; 
call sto8char$8inc; 
OS a oa 
end; 
char = titl: 
call stofchar8inc: 
char = @: “must make str lenght an aldr quantity */ 
call stoSchnr8inc; 
end; 
else 
if curehar = int then 
do; 


cali sto&8charS83ince: 


=I 
~! 





' hold = buff + 1: 
fieldSlength = 0: 
do while nextS$char ‘> @: 
fieldSlengeth = fileldSlencth + ft; 


* end; 


@# = convertStoSintfhold.fieldSlength): 


codeptr = codeptr + 2; 
end; 


else on 

if curchar = deci then 
cto ; : 
esll atoSchar8inc; 

call ixntebuf; 

eall packSdecimal(buff.cedeptr) ; 
codeptr = ptrStwo + {[: 

buff = ptrSBone + 2: 


end; 
else 
do; 
eall sto8charS8inc: 
if Ceurchar = brs?) or (eurchar = hse) 
do; 
call getStwoS8hyites: 
a = a + codebase: 
eall incS8codeptrstwo; 
end; 
else 
if Ceurchar = iml) or (Ceurehar = deb: 
do; 
call incbuf; 
eall sto8char8inc: 
end; 
else 
if curchar = im2 then 
do; 
call incbuf;: 
call sto8char$inc: 
call inebuf; 
cali sto8charS$inc;: 
end; 
end; 
end; 
gtackbase = codeptr; 


/*® atart of interp */ 


execute: procedure; 
do forever; 


then 


then 


tf rolt(c,1!) then “*% must he Jit or tLtit-lod ¥*/ 


do; 
eall push8etack(2?: 


bra = cC lt): 4* load in reverse ecrder */ 


bra(l) = ¢@ and 3fh; “* mask 


ara = (ara + prt8base) or 4000h. 
if rol€c,2) then call load(ra): 


call stepSBinsS8ent‘ {': 
end: 
else 
do case c; 


/*® @ case 9 not usedk/ 
‘ 


% 1 str €/ 
— do; 
call push8stack‘2): 
eall stepBinsScnt( 1): 
re = re + ¢ + i: 
ara = re or 4F8690h; 
call gtepBinsFent(i:; 
end; 


=| 
JN 


bite 10 X/ 


y* set Ol 


addr bita x#*/ 





Y*& 2 int ¥F/ 


do; 
call push8stacki 2) ; 
call step8ins$cent(1?: 


ara = two8byteSoprand ; 
call step8insSenti is; 
end} 


/* 3 xch */ 


dos 
hold = ara: 
arn = arb; 
arb = hold; 
end; 


“* 4 lod */ 
ceall tload(ra); 


/® 5& deb a a 
do; 
call stepSinsScnt/fl'; 
call decrementSbiktc’: 
end; 


/*®% 6 dmp */ 
call erlfs 


SR J xit ¥*/% 
return: 


“* 8 ald *7 
do: 
eal] setSup8alloc:;: 
call allocateS8dec; 
prtSentry=ra or 4006h; 
end: 


4% 9 ale */ 
do; 
call setSup8alloc; 
call allocate8str; 
prtSentry=ra or 400600h: 
end; 


“*¥10 anid */ 

do; 

call set8up8alloc; 
call allocate$dec;: 
prtSentrytra or 400H0h; 
call push8stack(2); 
bra = ctr: 

end; 


7*¥1L1 alse */ 
do}; : 

call setSup8alloc; 
¢all allocate@%atr; 
prtSentry=ra or 4009h: 
eall push8stack’ 2); 
ara = arb: 

erid 3 


4¥12 adi */7 
do; 
call set8up8nec: 
arb = addSintlarb.ara); 
call check8neg; 
call popf8stack: 
end: 


Z*13 add */ 
do: 





call setSup8regs; ‘’* puts values of top two Items “. 
; ‘* in reg?) ond re@wl respective tw.’ 
eall allign: 
call add; 
eallt cpy8reg2Sonetack: 
end; 


SES abi 7 


dos 
call set8up$nez; 
arb = subSintlarb.ara?l;: 


call check$neg; 
call pop$stack:; 
end i 


/*# 13 sbd */ 
do; 
call satSup8regs; “* puts values af top two items *- 
yk in regQ® and regl respectively” - 
call allign; 
call compliment(@); 
if sign® then sign? = negative; 


else sign® = positive; 

call add; 

call cpy®reg2$Sonstack: 
end: 


/#16 mpi *~” 


do: 
cail setSup8nee; 
arb = mulSint(arb,arn): 


eall check$Sneg: 
cail pop8stack; 
end; 


S*LET mod */ 
do: 
call setSupsreazs; “k puts values of top two items */ 
fk in reg@ and regi reepectively*/” 
deciare (i,index) hyte; 
call setSmultSdiv; 
decpt2 = decpt9® + deeptl;: 
i = 10; 
do index = 1 to 190; 
call multiply(€ril(i:=i-1) and Ofh); 
eall multipiy(€shrfri(€i),4)); 
end; 
call cpy$reg22onstack; 
end; 


#18 dvi *7 
do; 
call set8upSneg; 
arb = div®int(arb.ara); 
call check#neg; 
cesil pop@stack: 
end; 


L419 dvd */ 
das; 
eall setSup8rergs; “’* puts values of top two items 
/*® in reg® and regl respectively: 


ap 
+. 


call divide; 
coll cpySree2Sonatark: 
end: 


/X2O *yY 
7X not used */ 
: 


72) RY. 
/®¥ not used *&’ 
j 





A*2Q2Z new */ 
do; , . 
if check8int(ara) then 
‘ara = ~ara and Obf ‘fh: 
else if check&templara: then 


ara = ara xor O16Qh: “Xchange sien bit*/ 
else 
do} 
hold = mask(ra)?:; 
hSaddr = hSaddr xor 891960h, 
ends 
end: 


/¥23 cll */ 
4* not implemented */ 


SR24¢ ci2ld */ 
7* not implemented 7 


. 
? 


/*25 deci */ 

do}3 
call push8etack( 2): 
call stepS8insScnt( 1}; 
re=re + c + 23 
ara = re or 400@60h; 
call step8insScnt( 1); 

end; 


/#¥26 pop */ 
call popS8stack; 


A*Q2T mt ¥*/ 
dos 
call push8stack( 2): 
call step8insScnt( 1); 
arag=c;3 
end ; 


/*®28B im2 */ 

do: 
call push8setack( 2) ; 
eall step8insScnt( 1); 
brazce(1l); 7* load in reverse */ 
bra( l)=c; 
call step8insScnt( 1); 

end; 


SKOQ oS 
Y* not used */ 
; 


4*9Q0 7 
7*® not nsed */ 
; 


4231 cat £4 
call concatenate: 


“32 bli *-4 
bik bik@leveal:*=b1k8lewel+t) = ra; 


7*33 bld *-/ 
call decrementBbIik( 1); 


4/*34 brs *€/ 
cas! branchBabsolute;: 


RBS bac */ 
if bra = O then 
eall bBranehSabenlute; 





else 3: 

doy. 
call stepSinsScnt(2);: 

call pop8stack; 

end 5 


/*36 lssk/  . 
| Gove? |." , 
if brb < bra then 
- brb21; 
else brb=@; 
call popSstack; 
end; i ‘ 


é 


 /R37 diss : 
/* not implemented */ 


a 
4*38 sias */'- 
“* not implemented */ 
t 
SRID gtr ** 
do; 
if brb > bra then 
brb=I; 
else brb=8; 
call pop8stack; 
end: 


4*49 dgtr */ 
“7* not implemented %/ 


: 
4*41 s@etr */ 
4* not implemented */ 


/*42 eql */ 
do; 
if brb = bra then 
brb=1; 
else brb=0; 
. eall popSstacks 
end; 
/*43 deql */ 
/* not implemented */ 


$ 
4X44 geql */ 
“*® not implemented */7 


4¥*45 neg */ 
do} 
if brb. <> bra then 
brb = 13. 

else brb = @; 
call: pop8atack;: 
end ; : 
4%*46 dnegw */ 
7* not implemented *#/ 


-_ ; 

PR4C dneg ** 

/*® not implemented */ 
a : . 


S248 ged */ 
do; 
if brb >= bra then 
brb = 1: 
eise hrb = OF 
call pop®stack: 
end; 
4249 dgeq */ 
/* not implementea */ 
4 
/*58 sgreq */ 
/* not implemented */ 
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\ 


SR3SY leq *4 
dor: aa 
‘ if brb “2 bra then 
we brb = 13 
el@e brb'= @; 
call pop@stack: 
: ends 
/*52 dleq */ ; 
/* not implemented ¥*/ 
. ae ee: 
7¥*33 wleq ¥*/ . 
7*' not implemented ¥*/ 


} 


“9 


S854 inot */ 


do}; 
if bra = 90 then 
. bra = Is 
elae bra = @; 
end; 


/*55 dnot */ 

“* not implemented */ 
; 

/*56 snot */ 

/*® not implemented */ 


4457 iand */ 
do; 
if (bra-@) or (brb=0) then 
brb=1; 
else brb=-@; 
call popSstack; 
end 3; 
7258 dand */ 
/* not implemented */ 


/*89 sand */ ; 
4% not implemented */ 


S*68 tor */ 
do; 
if (bra=0) and (brb=9) then 
brb21; 
else brb#®; 
| call popSstack:; 
end ; 
4261 dor ¥*/7 
/¥ not implemented */ 
§ 
/*6Z sor */ 
/* not implemented %/ 
f 
/*t63 wie */ 
do; | 
call writeS8int(ara,®):; 
call popS8stack;: 
end; 


A*64& wde */ 
. do; 

if checkStemp(ara) then 
call write@dec(ra.@);: 

else 
call writeSdec(maek(ra) ,9); 

call pop8estack: 

end ; aa 


/*63 wae */ 
do: 
if checkStemplara) then 
call writeSstr(ra,@); 
atge 
call writeSstr(mask(ra),@); 
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/*66 
SOC 
/t68 


S69 
SRO 
Ret 
SRU2 
SVB 
SETS 
ARVS 
/*76 
Zee 


S/%*78B 


L2OG 


/*80 


S*BI 


call popS8atack: 


end; , 
wid */7 
call writeStoS8disgk(9); 
wid */ 
“* call writeBto8disk( 1); 
wad %*/ — 
call wrlteSto8disk(2); 
sbr */ 
do; 
arb = ara ~- arb; 
call popS8stack; 
ends 
bra */ 
do; 
re = codeSbase + ara; 
call pop$stack; 
end}: 
row */ 
call calcSrow; 
sub */— 
call calcSsub; 
rei */ 
call get#intSfield; 
red */ 
call getSdec8fleld; 
res */ 
call getSstr8fieid; 
rdi */ 
do}; 
inpuattype = @; 
call getSintSfleld; 
end: 
rdd *®/ 
do; 
inputtype = @: 
call get8dec8field; 
end; 
rds */ 
da} 
inputtype = 6; 
call getSstr@fleid; 
end; 
ren */ 
do; 
inputtype = 1[; 
rereadaddr = re; 
call consoleS8rend: 
end; 
ecr */ 
if moreSconS8input then 
call consoleS8inpntSerror; 
sli */ 
do}; 
call sgtoreBint(rh,ara):; 
rb = rb - 2; 
end: 
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"G2 sdi */ | 


\ 


do 3 . 
call store8dec(ra.rb?); 
rb #2 rb - 2; 


/*83 sai #/ 


eall store8str(ra,rb); 
rb = rb =- 2: 


S*B4 sid *7 


call storeSint(rb,ara); 
call popS8stack: 
call popSstack; 


/*85 sdd */ 


call storeBdec(ra,rb?; 
call popSstack; 
call popSstack:; 


/*86 aed */ 


eall store8str(ra,rb); 
call popSstack; 
call popSstack;: 


SRBT opn */ 
call diskS8open; 


/*88 cla */ 


call set8fite$addr; 
call disk$cloae;: 
call popSstack; 


/*B9 rdb */ 
4/* ready sequential block ¥*/ 
do3 
call setup8diskSio; 
call setSeof8stack; 
end; 


#90 rdf */ 
/* ready random block */ 
do} 
call sgetup8disk$io; 
call rdndom8setnp: 
call setBeof8stack; 
end ; 


SROL edr®/ 
4% end of record for read X/ 
/® advancea@a to next line feed ¥*/ 
do; 
if varShlockSs#ize then 
do while getSdisk8char <> If; 
; end; 
call storeBSrec8ptr; 
end; 


7/92 edw k/ 
“*® end of record for write */4 
do}s : 
1f varSblock8size then 
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‘do while bytesfuritten < (biccksize - 2); 
enll writeSaSbyteo” ‘); 

end; 

call writeSaSbyte(cr): 

call wrtiteSaBbyte( if): 

call: store8recSpir; 

- ends 


e 


~~ 


/*93 pro */ 


jG dos 3 be: 
stachtop = stacktop - 2; 
retSaddr = re ; 


re = ara + eodebase; 
call pop8etack; 
end; 


A*O4 sad 87 
do; : 

deciare (i,num) byte: 

pebptr = mask(ra); 

call popS8stack; 

moveScnt = arat 

eall popS8stack:;: 

lf ara <> @ then 

do; 
hold = ray 
counter = 2 * ara + 1; 
do i = f to counter; 

call pop8sta-k: 


end; 
num = hold - ra 
if (tempi := stacktop - num) <= ra then 


call error('mo'!; 
call move(rat+2, templ.num); 
call fill( temp1-2.°@h,2); 
end; 
elise 
call popSstack: 
blk€blklevel:=blkieve 1+!) =ra; 
if pebSvalne(!) = 0 then 
peb8Svalue(l) = I: 
else 
call sav8pcb; 
end: 


SRB aw2 */ 
do; 
declare i byte. 
parm8count address; 
tad! = ra; 
tad2 = rb; 
tad3,ra = stacktop - 3; 
rb = ra —~ 23 
parm@count = ara; 
call pop8stack;: 
pebptr = pebptr + 4+ + parm8count * 2; 
do ft = 1 to parm8connt: 
tegtvalue = ara; 
call popS8stack,; 
if testvalne = int then 
eall storeSin!! .pebptr,ara) ; 


else : 
if testvalue = deci then 
call gtore®Jdec(ra.pcebptr): 
else 


call storefatr(ra.pebptr) ; 
call pop8stack; 
pebptr = pebptr - 2: 


end; 

ra = tadl; 

rb = tad2; 

tad3 = 0; 
ends 
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%y 


/*96 uns *7 
do; ‘ , 
hold = mask(ra); 
ret@value = h®addr; 
cali decrementSbiké 1); 
; : if hSaddr( 1) <> 1 ther: 
- cali ansave; 
pm else 
a h8addr(i) = @; 
call decrementSbik(i:., 
call: pushSstack( 2): 
if check8lint(retSvelne)> then 
’ ara = retSvalue: 
else 
do; 
templ = mask(.r-tSvelue); 
call move(temp! - tl,ra,tit2): 
ra = ra + tl; 
bra( id = bral l) or O9c9h;: 
end; 
end; 


/*OT rtn */ 
do; 
re =_retSaddr; 
stacktop = stacktop + 2; 
end ; 


end; /*end casexX/ 
call stepSinsfcnt( 1); 
error$fiag = false; 
end ; /*% of do for ever */ 
end execute; 
mainline: 
eali crlf; 
call initializeS8execute; 
eofexit: Y* on end of file of current disk file come here ¥*/ 
errorexit: 4% regroup on cousole input error */ 
cail execute; 


call exitSinterp; 


eof ’ 
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